In my Workbook i have a CommandButton which opens a New Workbook and adds a CommandButton.
My Problem now is, that i always get the run time Error 9 when i click the Button.
This is my Code for the new Workbook:
Sub PM_Controlling_Click()
Dim relativePath As String
Workbooks.Add
relativeString = ThisWorkbook.Path & "\Test2"
ActiveWorkbook.SaveAs Filename:=relativeString & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Call Import_UserForm
Call Import_Modul
Call Working_Structur
End Sub
This i my Import Code:
Sub Import_UserForm
Workbooks("Test2.xlsm").VBProject.VBComponents.Import Filename:= _
"C:\Users\Desktop\Code_Samples\UserForm1.frm"
End Sub
Sub Import_Modul
Workbooks("Test2.xlsm").VBProject.VBComponents.Import Filename:= _
"C:\Users\Desktop\Code_Samples\AddAZ.bas"
End Sub
And here is my Working_Structur Modul where i try to add the Button with Code:
Sub Working_Structur()
Dim btn1 As Object
Dim Code As String
Set btn1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=105, Top:=175, Width:=50, Height:=25)
ActiveSheet.OLEObjects(1).Object.Caption = "Watch"
btn1.Name = "Watch AZ"
Code = "Sub Watch_Click()" & vbCrLf
Code = Code & "Call Watch_AZ_Sheet" & vbCrLf
Code = Code & "End Sub"
' Next Part causes the run time error
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, Code
End With
I hope someone can help me to solve this problem.
EDIT:
The error appears in Sub Working_Structure, the Line
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
causes the error.
My understanding is that Subscript out of range runtime error 9 is thrown when part of what is being referenced does not exist or is undefined.
Maybe the cause of the error is ActiveSheet.Name is not being the VBAComponent name
Please check the names of the VBA components matching your sheet actual name.
Below example throws error since the sheet name ActualSheetName is not the component name Sheet1
Renaming the Component name will fix the issue. Something like :
Update:
You can directly use the codename property of worksheet in the code.
Worksheet.CodeName MSDN
With ActiveWorkbook.VBProject.VBComponents(Worksheets(ActiveSheet.Name).CodeName).CodeModule
Related
Working with someone else's code here, and the previous code generates a worksheet called "Test". The code below is something I found from another post, and have adapted it. The aim is to create a button that is pasted on the "Test" sheet and calls on a macro "Mail" once the "Test" sheet is generated.
The issue is the current code does generate a button in the correct position, but it doesn't do anything/doesn't run the Mail() sub once the button is clicked.
Dim Obj As Object
Dim cmod
Dim Code As String
With ThisWorkbook.Worksheets("Test")
Set Obj = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=435, _
Top:=106.5, Width:=89.25, Height:=38.25)
Obj.Name = "ButtonTest"
Obj.Object.Caption = "Email Workbook"
Obj.Object.OnAction = "ButtonTest_Click"
Code = "Sub ButtonTest_Click()" & vbCrLf & _
"Call Mail" & vbCrLf & _
"End Sub"
With .Parent.VBProject.VBComponents(.CodeName).CodeModule
.insertlines .CountOfLines + 1, Code
End With
End With
I can't get your code to work at all in Excel 2016, fails with some un-debuggable errors when attempting to add the button. Try this similar code, instead:
Sub foo()
Dim Obj As Object
With ThisWorkbook.Worksheets("Test")
Set Obj = .Buttons.Add(Left:=435, Top:=106.5, Width:=89.25, Height:=38.25)
Obj.Name = "ButtonTest"
Obj.Caption = "Email Workbook"
Obj.OnAction = "Email_Template.Mail"
End With
End Sub
Above assumes Email_Template is a code module within the same workbook as ThisWorkbook.
Good morning
What I'm trying to do is using a command button in an Excel file in order to execute the following operations automatically:
Create a new workbook (new excel file)
Generate a command button in it
Have the command button with code in it (already programmed without associating an existing macro with it, it should already contain its own code)
All these operations should be thone following the instructions written for the first command button.
No problem about creating the new document, but generating a command button in it already programmed is hard for me.
I'm a beginner with vba
Thanks a lot
I found this to get you started. It creates a new sheet with a command button on it. You'll have to make some changes, but it's a good starting point for you. It's from Tim Williams on this site. Tim's a very seasoned coder !!
Sub wdlsinflow()
Dim sht As Worksheet
Dim Obj As Object
Dim Code As String
Dim cmod
Set sht = Sheets.Add(After:=Sheets(Sheets.Count))
With sht
.Name = "blah"
.Cells.Clear
Set Obj = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=200, _
Top:=100, Width:=100, Height:=35)
Obj.Name = "ButtonTest" '<< name must match code below...
Obj.Object.Caption = "Test Button"
Code = "Sub ButtonTest_Click()" & vbCrLf & _
" Call Tester" & vbCrLf & _
"End Sub"
With .Parent.VBProject.VBComponents(.CodeName).CodeModule
.insertlines .CountOfLines + 1, Code
End With
End With
End Sub
I am trying to write some codes to place a button into my worksheet automatically and when click on the button it will execute some codes. I wrote my code based on the example I saw from the book "Excel 2013 Power Programming with VBA" (p896). I am using Excel 2007 though not sure if it matters. Anyways, I modified the codes to below:
*Sub AddButtonAndCode()
Dim NewButton As OLEObject
Dim NewSheet As Worksheet
Set NewSheet = Worksheets("Sheet1")
Set NewButton = NewSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=5, Top:=5, Height:=25, Width:=100)
Code = "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " MsgBox ""???""" & vbCrLf
Code = Code & "End Sub"
With ActiveWorkbook.VBProject.VBComponents(NewSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With
End Sub*
It works for the button part, but after I added the parts below defining the button, it gives me error "Subscript out of range"
Could anybody help me to figure out what's wrong in there?
Thank you very much!
Your code works for me with a couple of tweaks.
Sub AddButtonAndCode()
Dim NewButton As OLEObject
Dim NewSheet As Worksheet, Code As String
Dim nextline As Long
Set NewSheet = Worksheets("Sheet1")
Set NewButton = NewSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=5, Top:=5, Height:=25, Width:=100)
NewButton.Name = "CommandButton1" '<<<<<<<<< ensure correct name
Code = "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " MsgBox ""???""" & vbCrLf
Code = Code & "End Sub"
'Use NewSheet.CodeName not NewSheet.Name
With ActiveWorkbook.VBProject.VBComponents(NewSheet.CodeName).CodeModule
nextline = .CountOfLines + 1
.InsertLines nextline, Code
End With
End Sub
In a fresh workbook a sheet's Name and CodeName will be the same, so your original line would work in that case, but would then fail if either the sheet or its code module was renamed.
This macro is one that was not written by me, so I'm having trouble understanding the source of the error. I have a macro that's supposed to run on startup to adjust the ribbon to add a button, and another part to remove styles when you select that button. Currently, I get the message: Object variable or With block variable not set. When I select "Debug" it goes to the VBA screen and immediately gives me 3 more error pop-ups that say: Can't execute code in break mode.
The first part of this is the two subs that are to run on startup, which are:
Dim WithEvents app As Application
Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
Module1.MyRibbon.Invalidate
End Sub
Private Sub Workbook_Open()
Set app = Application
End Sub
It highlights the Module1.MyRibbon.Invalidateas the problematic bit. Personally I don't see anything wrong with this per se, but perhaps the problem is in the Module 1? That code contains three subs, as follows:
Public MyRibbon As IRibbonUI
'Callback for customUI.onLoad
Sub CallbackOnLoad(Ribbon As IRibbonUI)
Set MyRibbon = Ribbon
End Sub
'Callback for customButton getLabel
Sub GetButtonLabel(control As IRibbonControl, ByRef returnedVal)
If ActiveWorkbook Is Nothing Then
returnedVal = "Remove Styles"
Else
returnedVal = "Remove Styles" & vbCr &
Format(ActiveWorkbook.Styles.Count, "#" & Application.International(xlThousandsSeparator) & "##0")
End If
End Sub
Sub RemoveTheStyles(control As IRibbonControl)
Dim s As Style, i As Long, c As Long
On Error Resume Next
If ActiveWorkbook.MultiUserEditing Then
If MsgBox("You cannot remove Styles in a Shared workbook." & vbCr & vbCr & _
"Do you want to unshare the workbook?", vbYesNo + vbInformation) = vbYes Then
ActiveWorkbook.ExclusiveAccess
If Err.Description = "Application-defined or object-defined error" Then
Exit Sub
End If
Else
Exit Sub
End If
End If
c = ActiveWorkbook.Styles.Count
Application.ScreenUpdating = False
For i = c To 1 Step -1
If i Mod 600 = 0 Then DoEvents
Set s = ActiveWorkbook.Styles(i)
Application.StatusBar = "Deleting " & c - i + 1 & " of " & c & " " & s.Name
If Not s.BuiltIn Then
s.Delete
If Err.Description = "You cannot use this command on a protected sheet. To use this command, you must first unprotect the sheet (Review tab, Changes group, Unprotect Sheet button). You may be prompted for a password." Then
MsgBox Err.Description & vbCr & "You have to unprotect all of the sheets in the workbook to remove styles.", vbExclamation, "Remove Styles AddIn"
Exit For
End If
End If
Next
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
I've never written any Activation or Ribbon-related macro, so I have no idea where the error could be. The addin works just find regardless of this message, as the button gets added and it functions as it should when the file isn't a blank file, but I get the error pop-up and the button doesn't get created right on new, blank files. How could I fix this?
I simply deleted:
Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
Module1.MyRibbon.Invalidate
End Sub
No runtime errors on start of excel and no issues when using the script; counts fine and deletes fine. Windows 7, Excel 2010.
I'm at a loss when trying to figure out where this code is tripping up. I am looking to rename the activesheet by using a concat of two ranges on the activesheet and some static text. When only one worksheet is in the workbook, the code works great. As soon as a second worksheet is added, I get a Runtime Error 1004. I'll highlight the line of code where it is breaking. This code currently resides in a normal module.
Option Explicit
Sub updateName()
Dim fNumber
Dim pCheckNumber
Dim asName As String
Dim tempASName As String
Dim worksheetName As Object
If ActiveSheet.Name = "Launch Page" Then Exit Sub
fNumber = ActiveSheet.Range("FlightNumber").Value
pCheckNumber = ActiveSheet.Range("PerformanceCheckNumber").Value
If fNumber <> "" And pCheckNumber <> "" Then
tempASName = "Flight " & fNumber & " | Run " & pCheckNumber & " (0.0%)"
asName = tempASName
MsgBox ActiveSheet.Name & vbCr & asName
ActiveSheet.Name = asName
worksheetName.Caption = asName
Else
Exit Sub
End If
End Sub
I'm in the process of adding error checking to ensure that I don't have duplicate sheet names. However, due to the nature of the field names, this will never occur.
I appreciate all of the insights!
The error you are reporting is, most likely, provoked because of trying to rename a Worksheet by using a name already in use. Here you have a small code to avoid this kind of situations:
Dim newName As String: newName = "sheet1"
Dim addition As String: addition = "_2"
Do While (Not sheetNameFree(newName))
newName = newName & addition
Loop
Where sheetNameFree is defined by:
Function sheetNameFree(curName As String) As Boolean
sheetNameFree = True
For Each Sheet In ActiveWorkbook.Sheets
If (LCase(Sheet.Name) = LCase(curName)) Then
sheetNameFree = False
Exit Function
End If
Next Sheet
End Function
You can adapt this code to your specific needs (for example, by converting addition into a number which grows after each wrong name).
In your code I see one other problem (although it shouldn't be triggering a 1004 error): you are accessing the property Caption from an non-instantiated object (worksheetName), whose exact functionality is not too clear. Just delete this line.
NOTE: good point from KazJaw, you might be using an illegal character. If fNumber and pCheckNumber are numbers or letters, it would be OK.
NOTE2: if with worksheetName you want to refer to an ActiveX Label in your workSheet, better do: ActiveSheet.Label1.Caption (where Label1 is the name of the Label). You cannot define worksheetName as a Label, because it is not a "conventional Label".