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.
Related
Good Morning everyone,
I am facing a strange Problem in Excel VBA.
So, I have this minimal Example. The only thing it's supposed to do is, add a Button to the Rightklick context menu. This button should then select a cell.
I searched a bit on StackOverflow and found a solution to passing string arguments in .onaction. But then it gets tricky. I can assign a Range and I can Print the Address and the second Argument in a Mesgbox. But I can't set Breakpoints and even stop doesn't work, nor will .select or .ScrollColumn do anything.
To Replicate just copy the Following code into a standard Module and Execute AddContextmenu to add the Button to the Contextmenu.
Option Explicit
Public Sub AddContextmenu()
Dim MySubMenu As CommandBarControl
Dim i As Long
'Clear Previous Menu Items
For Each MySubMenu In Application.CommandBars("Cell").Controls
If Not MySubMenu.BuiltIn Then
MySubMenu.Delete
End If
Next
'add menu
AddScrollButtons Application.CommandBars("Cell"), 1
End Sub
Public Sub AddScrollButtons(ByVal ContextMenu As CommandBar, ByVal baseindex As Long)
Dim cbb As CommandBarButton
Dim sFunction As String
'Add Button
Set cbb = ContextMenu.Controls.Add(Temporary:=True)
With cbb
sFunction = BuildProcArgString("ScrolltoColTest", "$F$10", "TestArg") ' Get Onaction string
.OnAction = sFunction
.Caption = "Scroll Tester"
.Style = msoButtonAutomatic
End With
End Sub
Function BuildProcArgString(ByVal ProcName As String, ParamArray Args() As Variant)
Dim tempArg As Variant
Dim temp As String
For Each tempArg In Args
temp = temp + Chr(34) + tempArg + Chr(34) + ","
Next
BuildProcArgString = "'" & ThisWorkbook.Name & "'!" & ProcName + "(" + Left(temp, Len(temp) - 1) + ")" ' (Workbook has to be included to ensure that the sub will be executed in the correct workbook)
End Function
Public Sub ScrolltoColTest(Addr As String, OtherArg As String)
Dim cell As Range
Set cell = ActiveSheet.Range(Addr) 'Get Cell that sould be selected from Addr
MsgBox cell.Address & vbNewLine & OtherArg 'Test if the Arguments have been passed correctly and the cell has been assigned
Stop 'Why doesn' this stop?
cell.Select 'Why doesn't this do anything
ActiveWindow.ScrollColumn = cell.Column 'Why doesn't this do anything
End Sub
As you will see in ScrolltoColTest the Part after the Msgbox will not work at all.
Does anyone know why that happens?
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
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
Forgive my noob-ery. Assistance greatly appreciated!!!!
Purpose of macro: Fill in form in Microsoft Word with text originating in an Excel workbook from a specified worksheet.
My problem: Selecting said worksheet to draw that information from and integrating result into my code. Using an InputBox for now but would like to replace said InputBox with a UserForm with a ComboBox- giving pre-set choice for worksheet names (these never change).
I've created the UserForm with the choices. How do I get my code to initialize it? And how do I get my code to use the result from the ComboBox?
Sub Ooopsie()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim exSh As Excel.Worksheet
Dim strSheetName As String
Dim strDefaultText As String
strDefaultText = "sheet name here"
strSheetName = InputBox( _
Prompt:="The sheet name is?", _
Title:="Sheet Name?", _
Default:=strDefaultText _
)
If strSheetName = strDefaultText Or strSheetName = vbNullString Then Exit Sub
Set exWb = objExcel.Workbooks.Open("path to worksheet")
ActiveDocument.Tables(1).Rows(3).Cells(1).Range.Text = "Blah: " & exWb.Sheets(strSheetName).Cells(3, 3)
ActiveDocument.Tables(1).Rows(5).Cells(1).Range.Text = "blah blah : " & Chr(11) & "blah: " & exWb.Sheets(strSheetName).Cells(3, 1)
ActiveDocument.Tables(1).Rows(6).Cells(1).Range.Text = "Date de réception : " & Chr(11) & "Date Received : " & exWb.Sheets(strSheetName).Cells(3, 2)
ActiveDocument.Tables(1).Rows(7).Cells(1).Range.Text = "blah d : " & Chr(11) & "Deadline: " & exWb.Sheets(strSheetName).Cells(3, 4)
exWb.Close
Set exWb = Nothing
End Sub
I refined your code some. This should get you started. I reworked it to make it easier for you to see what's going on. Instead of opening an existing workbook I create a new workbook. I left the Inputbox in there with some error handling so you get an idea of what you should do. The code now right from the MS Word table to Excel.
Option Explicit
Private Sub CommandButton1_Click()
Dim xlApp, xlWB, xlWS
Dim strSheetName As String, strDefaultText As String
Dim tbl As Table
strDefaultText = "Sheet1"
strSheetName = InputBox( _
Prompt:="The sheet name is?", _
Title:="Sheet Name?", _
Default:=strDefaultText)
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Add
On Error Resume Next
Set xlWS = xlWB.WorkSheets(strSheetName)
If Err.Number <> 0 Then
MsgBox "Worksheet [" & strSheetName & " Not Found", vbCritical, "Action Cancelled"
xlWB.Close False
xlApp.Quit
Exit Sub
End If
On Error GoTo 0
xlApp.Visible = True
On Error Resume Next
If ActiveDocument.Tables.Count > 0 Then
Set tbl = ActiveDocument.Tables(1)
xlWS.Cells(3, 3) = tbl.Rows(3).Cells(1).Range.Text
xlWS.Cells(3, 1) = tbl.Rows(5).Cells(1).Range.Text
xlWS.Cells(3, 2) = tbl.Rows(6).Cells(1).Range.Text
xlWS.Cells(3, 4) = tbl.Rows(7).Cells(1).Range.Text
End If
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
It is worth noting that you can't instantiate Excel from MS Word like this without a reference to the Microsoft Excel 12.0 I think is?
Dim objExcel As New Excel.Application
Use this instead
Dim objExcel as Variant
Set objExcel = CreateObject("Excel.Application")
I know that this is not a chat forum but I am open to opinions and advice. I am only a hobbist after all.
Update here is how one way add items to a combobox
For Each xlSheet In xlWB.Worksheets
ComboBox1.AddItem xlSheet.Name
Next
So you've created a form called UserForm1.
You can display it as a modal dialog using the default instance:
UserForm1.Show vbModal
But a better practice would be to instantiate it instead - forms are objects after all, so you can New them up like any other class module:
Dim view As UserForm1
Set view = New UserForm1
view.Show vbModal
You can add properties to your form's code-behind to expose values the calling code can use:
Public Property Get SheetName() As String
SheetName = ComboBox1.Text
End Property
So you can now write a function that does this:
Private Function GetSheetName() As String
Dim view As UserForm1
Set view = New UserForm1
view.Show vbModal
GetSheetName = view.SheetName
End Function
Now you can replace your InputBox call with a call to this GetSheetName function!
Of course you'll want to handle the case where the user cancels out of the form, but that's beyond the scope of this question, and... it's been asked on this site already, just search and you'll find!