excel vba + how to programmatically add code to button - vba

I have a button in a workdbook (wbShared), clicking on that button a second workbook (wbNewUnshared) opens. I want to add a button to wbNewUnshared with code programmatically.
I already found how to add the button, but I didn't find how to add code to this button.
'create button
'--------------------------------------------------------
Dim objBtn As Object
Dim ws As Worksheet
Dim celLeft As Integer
Dim celTop As Integer
Dim celWidth As Integer
Dim celHeight As Integer
Set ws = wbNewUnshared.Sheets("Sheet1")
celLeft = ws.Range("S3").left
celTop = ws.Range("T2").top
celWidth = ws.Range("S2:T2").width
celHeight = ws.Range("S2:S3").height
Set objBtn = ws.OLEObjects.add(classType:="Forms.CommandButton.1", link:=False, _
displayasicon:=False, left:=celLeft, top:=celTop, width:=celWidth, height:=celHeight)
objBtn.name = "Save"
'buttonn text
ws.OLEObjects(1).Object.Caption = "Save"
I found this online:
'macro text
' Code = "Sub ButtonTest_Click()" & vbCrLf
' Code = Code & "Call Tester" & vbCrLf
' Code = Code & "End Sub"
' 'add macro at the end of the sheet module
' With wbNewUnshared.VBProject.VBComponents(ActiveSheet.name).codeModule
' .InsertLines .CountOfLines + 1, Code
' End With
But this gives an error in the last line. Anybody has a clue?
tx
EDIT:
SOLVED
Ok, the code given works, I had an error 'Programmatic Access To Visual Basic Project Is Not Trusted'. Thanks to the help of S Meaden I solved that via https://support.winshuttle.com/s/article/Error-Programmatic-Access-To-Visual-Basic-Project-Is-Not-Trusted.
after that my code worked. So thanks again.

The first code I provided assumes 1 workbook. The code I'm presenting now does not. The limitation of this is that if the arrBttns is lost, the project is reset, the link between the code and the button is lost and the procedure addCodeToButtons has to be run again.
In the wbNewUnshared, create a class module with the following code
Option Explicit
Public WithEvents cmdButtonSave As MSForms.CommandButton
Public WithEvents cmdButtonDoStuff As MSForms.CommandButton
Private Sub cmdButtonDoStuff_Click()
'Your code to execut on "Do Stuff" button click goes here
MsgBox "You've just clicked the Do Stuff button"
End Sub
Private Sub cmdButtonSave_Click()
'Your code to execut on "Save" button click goes here
MsgBox "You've just clicked the Save button"
End Sub
In the wbNewUnshared add a standard module with the following code
Option Explicit
Dim arrBttns() As New Class1
Public Sub addCodeToButtons()
Dim bttn As OLEObject
Dim ws As Worksheet
Dim i As Long
ReDim arrBttns(0)
'Iterate through worksheets
For Each ws In ThisWorkbook.Worksheets
'Iterate through buttons on worksheet
For Each bttn In ws.OLEObjects
'Expand arrBttns for valid buttons.
If bttn.Name = "Save" Or bttn.Name = "DoStuff" Then
If UBound(arrBttns) = 0 Then
ReDim arrBttns(1 To 1)
Else
ReDim Preserve arrBttns(1 To UBound(arrBttns) + 1)
End If
End If
'Link button to correct code
Select Case bttn.Name
Case "Save"
Set arrBttns(UBound(arrBttns)).cmdButtonSave = bttn.Object
Case "DoStuff"
Set arrBttns(UBound(arrBttns)).cmdButtonDoStuff = bttn.Object
End Select
Next bttn
Next ws
End Sub
In the wbNewUnshared add the following code in the ThisWorkbook module, this is to add the code to the buttons on workbook open.
Option Explicit
Private Sub Workbook_Open()
Call addCodeToButtons
End Sub
In the wbShared add the following line after you're done adding buttons
Application.Run "wbNewUnshared.xlsm!addCodeToButtons"
Original Answer
Add a class module to your project to which you add.
Option Explicit
Public WithEvents cmdButton As MSForms.CommandButton 'cmdButton can be an name you like, if changed be sure to also change the Private Sub below
Private Sub cmdButton_Click()
'Your code on button click goes here
MsgBox "You just clicked me!"
End Sub
To a module you add the code below
Option Explicit
Dim arrBttns() As New Class1 'Change Class1 to the actual name of your classmodule
'The sub which adds a button
Sub addButton()
Dim bttn As OLEObject
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set bttn = ws.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
ReDim arrBttns(0)
If UBound(arrBttns) = 0 Then
ReDim arrBttns(1 To 1)
Else
ReDim Preserve arrBttns(1 To UBound(arrBttns))
End If
Set arrBttns(UBound(arrBttns)).cmdBttn = bttn.Object
End Sub

Related

VBA check if all userform comboboxes have an option selected

I have a userform with many comboboxes and an "Ok" button. What I need is that when pressing that "Ok" button, VBA to check if there's no empty comboboxes. If all comboboxes have some value selected - close the userform otherwise return a message box and clicking "Ok" on that messagebox returns me to the userform with no filled values lost.
I've tried all the methods I could think of:
If PackageOuterRadius = null Then
if PackageOuterRadius is nothing Then
If PackageOuterRadius.value = 0 Then
If IsNull(PackageOuterRadius) = True Then
If IsNull(PackageOuterRadius.value) Then
What I've been trying to do is:
Private Sub Rigid_Filme_Ok_Button_Click()
If PackageOuterRadius.ListCount = 0 Then
MsgBox "Select a ""Package Outer Radius!"
End If
And absolutelly nothing actually checks if the combobox is empty and keeps returning a positive (That there's a value selected)
What could be the solution to this problem? Could someone, please, help me?
If you have few ComboBoxes only, you may insert lines underneath the OK button to check if all the ComboBoxes are filled but if you have too many ComboBoxes on UserForm, you may achieve this with the help of a Class Module and to do so, follow these steps...
Insert a Class Module and rename it to clsUserForm and the place the following code on Class Module...
Code for Class Module:
Public WithEvents mCMB As msforms.ComboBox
Public Sub CheckComboBoxes()
Dim cCtl As msforms.Control
Dim cntCBX As Long
Dim cnt As Long
For Each cCtl In frmMyUserForm.Controls
If TypeName(cCtl) = "ComboBox" Then
cntCBX = cntCBX + 1
If cCtl.Value <> "" Then
cnt = cnt + 1
End If
End If
Next cCtl
If cnt = cntCBX Then
Unload frmMyUserForm
Else
MsgBox "All the ComboBoxes are mandatory.", vbExclamation
End If
End Sub
Then place the following code on UserForm Module. The code assumes that the name of the userForm is frmMyUserForm and the name of the CommandButton is cmdOK.
Code for UserForm Module:
Dim GroupCBX() As New clsUserForm
Dim frm As New clsUserForm
Private Sub cmdOK_Click()
frm.CheckComboBoxes
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As Control
For Each ctl In Me.Controls
If TypeName(ctl) = "ComboBox" Then
i = i + 1
ReDim Preserve GroupCBX(1 To i)
Set GroupCBX(i).mCMB = ctl
End If
Next ctl
End Sub
And you will be good to go.

Creating a Command Button Class - For Word Command Buttons

I am trying to set some command buttons properties out in bulk . That is trying to set various properties of the command buttons in one go rather than repeat the code for each command button individually.
The document has 30+ command buttons.
In the Class - I have put the code below:
Option Explicit
Public WithEvents cMDButtonGroup As CommandButton
Private Sub cMDButtonGroup_Click()
With cMDButtonGroup
If .Caption = "Press" Then
' Add some other button properties
Else
.Caption = " Complete"
End If
End With
In a VBA Module - I have put the code below:
Option Explicit
Dim Buttons() As New cMDButtonClass
Sub Buttons()
Dim ButtonCount As Integer
Dim ctl As Control
' Create the Button objects
ButtonCount = 0
For Each ctl In ActiveDocument.Controls ' This may be wrong
If TypeName(ctl) = "CommandButton" Then
ButtonCount = ButtonCount + 1
ReDim Preserve Buttons(1 To ButtonCount)
Set Buttons(ButtonCount).ButtonGroup = ctl
End If
End If
Next ctl
End Sub
The above may have been sourced from VBA Express? Unfortunately I have lost the link.
Unfortunately I do not know how to proceed to fix this.
Final Solution: Tim's Code works perfectly. You also need to load the buttons
Put the below code in ThisDocument
Private Sub Document_Open()
Call SetupButtons
End Sub
cMDButtonClass (simplified)
Public WithEvents oBtn As CommandButton
Private Sub oBtn_Click()
MsgBox "clicked: " & oBtn.Caption
End Sub
In a regular module:
Dim colButtons As New Collection '< simpler to manage than an array
Sub SetupButtons()
Dim ButtonCount As Integer
Dim ctl, c
Dim oB As cMDButtonClass
'Following Cindy's comment...
For Each ctl In ActiveDocument.InlineShapes
If Not ctl.OLEFormat Is Nothing Then
Set c = ctl.OLEFormat.Object
If TypeName(c) = "CommandButton" Then
Set oB = New cMDButtonClass
Set oB.oBtn = c
colButtons.Add oB
End If
End If
Next ctl
End Sub

Excel - How to create button upon Workbook_Open event

I'm trying to make an Excel Add-In to create a simple button when any workbook is opened, but I'm getting
Object variable or With Block variable not set
I think this is happening because technically there is no 'ActiveWorkbook' yet.
First thing I want to do is delete any buttons currently on the sheet. Then I want to place a button.
Anyone know how to make that happen?
Code
Private Sub Workbook_Open()
ActiveWorkbook.ActiveSheet.Buttons.Delete
Dim CommandButton As Button
Set CommandButton = ActiveWorkbook.ActiveSheet.Buttons.Add(1200, 100, 200, 75)
With CommandButton
.OnAction = "Test_Press"
.Caption = "Press for Test"
.Name = "Test"
End With
End Sub
I then have a Private Sub Test_Press() to display a MsgBox. The button is not being created though.
Credit goes to http://www.jkp-ads.com/Articles/FixLinks2UDF.asp
Note: I have another module I didn't post below, which houses the macro Project_Count I tied to the button I place on the workbook only if the workbook name is TT_GO_ExceptionReport
I also have a VBScript that downloads the Add-In, places it in the users addin folder, and installs it. If you want to know how to do that, leave a comment.
Code of Add-In that solved the problem:
ThisWorkbook
Option Explicit
Private Sub Workbook_Open()
' Purpose : Code run at opening of workbook
'-------------------------------------------------------------------------
'Initialise the application
InitApp
modProcessWBOpen.TimesLooped = 0
Application.OnTime Now + TimeValue("00:00:03"), "CheckIfBookOpened"
End Sub
Module 1 named modInit
Option Explicit
'Create a module level object variable that will keep the instance of the
'event listener in memory (and hence alive)
Dim moAppEventHandler As cAppEvents
Sub InitApp()
'Create a new instance of cAppEvents class
Set moAppEventHandler = New cAppEvents
With moAppEventHandler
'Tell it to listen to Excel's events
Set .App = Application
End With
End Sub
Module 2 named modProcessWBOpen
Option Explicit
'Counter to keep track of how many workbooks are open
Dim mlBookCount As Long
'Counter to check how many times we've looped
Private mlTimesLooped As Long
' Purpose : When a new workbook is opened, this sub will be run.
' Called from: clsAppEvents.App_Workbook_Open and ThisWorkbook.Workbook_Open
'-------------------------------------------------------------------------
Sub ProcessNewBookOpened(oBk As Workbook)
If oBk Is Nothing Then Exit Sub
If oBk Is ThisWorkbook Then Exit Sub
If oBk.IsInplace Then Exit Sub
CountBooks
'This checks to make sure the name of the new book matches what I
'want to place the button on
If oBk.Name = "TT_GO_ExceptionReport.xlsm" Then
Dim CommandButton As Button
Set CommandButton = Workbooks("TT_GO_ExceptionReport.xlsm").Sheets(1).Buttons.Add(1200, 100, 200, 75)
With CommandButton
.OnAction = "Project_Count"
.Caption = "Press for Simplified Overview"
.Name = "Simplified Overview"
End With
End If
End Sub
Sub CountBooks()
mlBookCount = Workbooks.Count
End Sub
Function BookAdded() As Boolean
If mlBookCount <> Workbooks.Count Then
BookAdded = True
CountBooks
End If
End Function
' Purpose : Checks if a new workbook has been opened
' (repeatedly until activeworkbook is not nothing)
'-------------------------------------------------------------------------
Sub CheckIfBookOpened()
If BookAdded Then
If ActiveWorkbook Is Nothing Then
mlBookCount = 0
TimesLooped = TimesLooped + 1
'May be needed if Excel is opened from Internet explorer
Application.Visible = True
If TimesLooped < 20 Then
Application.OnTime Now + TimeValue("00:00:01"), "CheckIfBookOpened"
Else
TimesLooped = 0
End If
Else
ProcessNewBookOpened ActiveWorkbook
End If
End If
End Sub
Public Property Get TimesLooped() As Long
TimesLooped = mlTimesLooped
End Property
Public Property Let TimesLooped(ByVal lTimesLooped As Long)
mlTimesLooped = lTimesLooped
End Property
Class Module named cAppEvents
' Purpose : Handles Excel Application events
'-------------------------------------------------------------------------
Option Explicit
'This object variable will hold the object who's events we want to respond to
Public WithEvents App As Application
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
'Make sure newly opened book is valid
ProcessNewBookOpened Wb
End Sub
Private Sub Class_Terminate()
Set App = Nothing
End Sub
something like this?
Option Explicit
Sub Button()
Dim cButton As Button
Dim rng As Range
Dim i As Long
ActiveSheet.Buttons.Delete
For i = 2 To 3 Step 2
Set rng = ActiveSheet.Range(Cells(i, 2), Cells(i, 2))
Set cButton = ActiveSheet.Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
With cButton
.OnAction = "Test_Press"
.Caption = "Press for Test " & i
.Name = "Test" & i
End With
Next i
End Sub
See Example here

Self-referencing from inside an Excel VBA control

I'm trying to get a property value of a button control from inside the button's click event without using the button's name (since I want to use the same code for each of many buttons on the Excel sheet).
After much research, I see many references to try the following:
Me.ActiveControl.name
or
Me.Shapes(Application.Caller).Name
However, both of those throw an error when executed from within Excel. Note that I'm using Excel 2010.
Thanks for any help in advance.
Lee
What you want is possible but for that you need to create a Class
Do this.
Insert a Class Module and paste this code there.
Option Explicit
Public WithEvents MyButton As MSForms.CommandButton
Private Sub MyButton_Click()
MsgBox MyButton.Name
End Sub
Next Insert a module and place this code there
Dim shpButtons() As New Class1
Sub StartCode()
Dim shp As Shape
Dim btnCount As Long
ReDim shpButtons(1 To 1)
btnCount = 0
For Each shp In ActiveSheet.Shapes
If shp.OLEFormat.Object.OLEType = xlOLEControl Then
btnCount = btnCount + 1
ReDim Preserve shpButtons(1 To btnCount)
Set shpButtons(btnCount).MyButton = shp.OLEFormat.Object.Object
End If
Next
End Sub
Sub StopCode()
Dim iBtn As Long
On Error Resume Next
For iBtn = LBound(shpButtons) To UBound(shpButtons)
Set shpButtons(iBtn).TheText = Nothing
Next
End Sub
Now simply run the Sub StartCode()
Next when you click the ActiveX CommandButton then you will get it's name.
Try ActiveSheet.Shapes(Application.Caller).Name

Determine which button was pressed?

I'm wondering if there's a simple way for a Word macro to determine which button was just pressed? I have a document template with several button which should all fire a macro.
The thing is, I want to create ONE macro which is called in each button. I don't want tons of macros for each button.
Now, this macro, when the button is pressed, it inserts a picture and the size of this picture is selected based on the buttons size. Meaning, this ends up as a picture placeholder. But, I want to write the macro dynamically so that the same code will work on each button without doing more than just calling the macro.
The complete macro is already done, I just need to know this one last thing, if anyone has any info on how to accomplish this? :) Thanx in advance!
UPDATE: This is the code at the moment
Private Sub ImageButton1_Click()
PicturePlaceholder ImageButton1
End Sub
Private Sub ImageButton2_Click()
PicturePlaceholder ImageButton2
End Sub
Public Sub PicturePlaceholder(ByVal oButton As CommandButton)
Dim oShape As Word.Shape
Dim Dlg As Office.FileDialog
Dim strFilePath As String
Dim oDoc As Document
Dim rgePlace As Range
Dim buttonHeight As String
Dim buttonWidth As String
Set Dlg = Application.FileDialog(msoFileDialogFilePicker)
Set oDoc = ActiveDocument
Set rgePlace = Selection.Range.Fields(1) _
.Result.Paragraphs(1).Range
Response = MsgBox("Do you want to delete the button/Picture?", vbYesNoCancel, "Do you want an image here?")
If Response = vbYes Then rgePlace.Fields(1).Delete
If Response = vbCancel Then Exit Sub
If Response = vbNo Then
With Dlg
.AllowMultiSelect = False
If .Show() <> 0 Then
strFilePath = .SelectedItems(1)
End If
End With
If strFilePath = "" Then Exit Sub
Set oShape = oDoc.Shapes.AddPicture(FileName:=strFilePath, _
LinkToFile:=False, SaveWithDocument:=True, _
Anchor:=rgePlace)
With oShape
.Height = oButton.Height
.Width = oButton.Width
End With
rgePlace.Fields(1).Delete
End If
End Sub
OK, so they're CommandButtons in the document.
In that case, there's nothing you can do - you need to have handlers called Button1_Click, Button2_Click, etc. (or whatever the button names are).
However, you can do something like this:
Private Sub Button1_Click(...)
DoStuff Button1
End Sub
Private Sub Button2_Click(...)
DoStuff Button2
End Sub
Private Sub DoStuff(ByVal oButton As CommandButton)
' All your shared code goes here
MsgBox oButton.Caption
End Sub
See also this tech note for how to create your buttons in code.
EDIT: updated to pass CommandButton reference so that the shared function can access the button properties.
EDIT 2: updated to show complete code using InlineShapes. Note that this no longer passes in the Button object, since the width/height of the button can be obtained directly from the field.
Private Sub CommandButton1_Click()
PicturePlaceholder
End Sub
Private Sub CommandButton2_Click()
PicturePlaceholder
End Sub
Public Sub PicturePlaceholder()
' Get the selected field, which must be a button field
Dim oField As Field
Set oField = Selection.Fields(1)
Debug.Assert oField.Type = wdFieldOCX
' Ask the user what he wants to do
Select Case MsgBox("Do you want to delete the button/Picture?", vbYesNoCancel, "Do you want an image here?")
Case vbCancel
Exit Sub
Case vbYes
oField.Delete
Exit Sub
End Select
' Get the filename of the picture to be inserted
Dim strFilePath As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
If .Show() <> 0 Then
strFilePath = .SelectedItems(1)
End If
End With
If strFilePath = "" Then
Exit Sub
End If
' Figure out where to insert the picture, and what size to make it
Dim oRange As Range
Set oRange = oField.Result
Dim sglWidth As Single
sglWidth = oField.InlineShape.Width ' oButton.Width
Dim sglHeight As Single
sglHeight = oField.InlineShape.Height ' oButton.Height
' Delete the button field
oField.Delete
' Insert and resize the picture
Dim oInlineShape As Word.InlineShape
Set oInlineShape = oRange.InlineShapes.AddPicture(FileName:=strFilePath, LinkToFile:=False, SaveWithDocument:=True, Range:=oRange)
With oInlineShape
.Width = sglWidth
.Height = sglHeight
End With
End Sub
EDIT 3: Updated as requested to use Shapes rather than InlineShapes. (Both the CommandButton and the inserted Picture are now Shapes).
Private Sub CommandButton1_Click()
PicturePlaceholder
End Sub
Private Sub CommandButton2_Click()
PicturePlaceholder
End Sub
Public Sub PicturePlaceholder()
' Get the selected shape, which must be a button shape
Debug.Assert Selection.Type = wdSelectionShape
Dim oButtonShape As Shape
Set oButtonShape = Selection.ShapeRange(1)
' Ask the user what he wants to do
Select Case MsgBox("Do you want to delete the button/Picture?", vbYesNoCancel, "Do you want an image here?")
Case vbCancel
Exit Sub
Case vbYes
oButtonShape.Delete
Exit Sub
End Select
' Get the filename of the picture to be inserted
Dim strFilePath As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
If .Show() <> 0 Then
strFilePath = .SelectedItems(1)
End If
End With
If strFilePath = "" Then
Exit Sub
End If
' Insert the picture at the same size/position
Dim oPictureShape As Shape
Set oPictureShape = ActiveDocument.Shapes.AddPicture _
( _
FileName:=strFilePath, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=oButtonShape.Left, _
Top:=oButtonShape.Top, _
Width:=oButtonShape.Width, _
Height:=oButtonShape.Height, _
Anchor:=oButtonShape.Anchor _
)
' Copy across the button shape formatting
oButtonShape.PickUp
oPictureShape.Apply
' Copy across other layout details
oPictureShape.LayoutInCell = oButtonShape.LayoutInCell
oPictureShape.LockAnchor = oButtonShape.LockAnchor
oPictureShape.RelativeHorizontalPosition = oButtonShape.RelativeHorizontalPosition
oPictureShape.RelativeVerticalPosition = oButtonShape.RelativeVerticalPosition
oPictureShape.WrapFormat.Type = oButtonShape.WrapFormat.Type
oPictureShape.WrapFormat.Side = oButtonShape.WrapFormat.Side
oPictureShape.WrapFormat.DistanceTop = oButtonShape.WrapFormat.DistanceTop
oPictureShape.WrapFormat.DistanceLeft = oButtonShape.WrapFormat.DistanceLeft
oPictureShape.WrapFormat.DistanceBottom = oButtonShape.WrapFormat.DistanceBottom
oPictureShape.WrapFormat.DistanceRight = oButtonShape.WrapFormat.DistanceRight
oPictureShape.WrapFormat.AllowOverlap = oButtonShape.WrapFormat.AllowOverlap
' Delete the button shape
oButtonShape.Delete
End Sub
I assume you mean that the button is a Command Bar button (aka toolbar button).
If so, you can use Application.CommandBars.ActionControl to get a reference to the button that was clicked. From there you can examine the caption, tag, or whatever.
You could put your base macro into a separate sub and then just call the macro from each button's click event, passing as a parameter the desired size. Then the only code you would have in the buttons is the call to the base sub.
You can have a button in Vba to pass arguments when it calls the macro which takes arguments.
For eg: if you have a function called as function test(x as string)
then the button which calls the macro will have a syntax as onclick("sheetx!test", "whatever"). So that way you can either have a generic macro to be called. Hope this helps you.
Placing the following in the various click/got_focus/change events of ActiveX buttons and textboxes works for me:
MsgBox ThisDocument.ActiveWindow.Selection.Fields.Item(1).OLEFormat.Object.Name