How to add a command button and on-click within vba

[Papa Jonah]

My project I am working on does a lot of formating, reorganizing, and
calculations with VBA. When the code is done, I have a sheet that
"summarizes" what has been done through a "grading" scheme that my boss wants.

However, as the end-users analyze the data generated, we tweak the arrays or
ranges as necessary. When we do this, the data underlying the scores change,
thereby affecting the scores.
What I want to do is add a command button to my score sheet that, when
clicked, will re-run the scoring macro and update the scoring summary.

I am able to get the button to appear, but I can not figure out how to tell
the code what I want it to do when I click it.
Where I am getting confused is: I can add the button, change the caption
etc. I can even write the macro for it to follow "on-click". Where I get
lost is - when I try to include this into the vba code that is driving the
whole thing.

Below is the code that is used to draw the button. How do I modify this to
tell it to run the on-click macro?

ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1",
Link:=False _
, DisplayAsIcon:=False, Left:=31.2, Top:=240.6, Width:=85.2,
Height:= _
33.6).Select

 

[Bob Phillips]

Jonah,

Here is a working example of adding a button to a sheet with the code to go
with it

'-----------------------------------------------------------------
Sub CreateControlButton()
'-----------------------------------------------------------------
Dim oWs As Worksheet
Dim oOLE As OLEObject

Set oWs = ActiveSheet

Set oOLE =
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=200, Top:=100, Width:=80, Height:=32)

With oOLE
.Object.Caption = "Run myMacro"
.Name = "myMacro"
End With

With ThisWorkbook.VBProject.VBComponents(oWs.CodeName).CodeModule
.InsertLines .CreateEventProc("Click", oOLE.Name) + 1, _
vbTab & "If Range(""A1"").Value > 0 Then " & vbCrLf & _
vbTab & vbTab & "Msgbox ""Hi""" & vbCrLf & _
vbTab & "End If"

End With

End Sub



--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Papa Jonah]

Bob,
Your code is getting me there. Initially I pasted your code in to see what
happened. I had to change it as you can see below to get it to do anything.
However the line that starts with "With ThisWorkbook.vbproject...." has me
confused.
Even before I tried to interpret what you meant by "codename" and oOLE.name,
it didn't do anything.
The macro that I want the button to run is called "regrade".

Dim oWs As Worksheet
Dim oOLE As OLEObject

Set oWs = ActiveSheet

'Set oOLE =
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1",
Left:=31.2, Top:=240.6, Width:=85.2, Height:=33.6).Select

With Selection
.Object.Caption = "Re-Score"
.Name = "reGrade"
End With

With ThisWorkbook.VBProject.VBComponents(oWs.regrade).CodeModule
.InsertLines .CreateEventProc("Click", oOLE.regrade) + 1, _
vbTab & "If Range(""A1"").Value > 0 Then " & vbCrLf & _
vbTab & vbTab & "Msgbox ""Hi""" & vbCrLf & _
vbTab & "End If"

End With

I'm not sure what you added for example and what is necessary syntax for my
objective.

Thanks for your help.

 

[Bob Phillips]

Jonah,

My code ran perfectly for me, I tried it before posting. Your changes just
don't work for me. It might have been wrap-around, so try this version, un
changed, and see what happens
'-----------------------------------------------------------------
Sub CreateControlButton()
'-----------------------------------------------------------------
Dim oWs As Worksheet
Dim oOLE As OLEObject

Set oWs = ActiveSheet

Set oOLE = _
oWs.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=200, Top:=100, Width:=80, Height:=32)

With oOLE
.Object.Caption = "Run myMacro"
.Name = "myMacro"
End With

With ThisWorkbook.VBProject.VBComponents(oWs.CodeName).CodeModule
.InsertLines .CreateEventProc("Click", oOLE.Name) + 1, _
vbTab & "If Range(""A1"").Value > 0 Then " & vbCrLf & _
vbTab & vbTab & "Msgbox ""Hi""" & vbCrLf & _
vbTab & "End If"

End With

End Sub

oWs.CodeName is the VBE name for the worksheet where the button resides, so
don't change that as the code needs to be inserted there. oOLE.Name is the
name of the button for which a click event will be created, so don't change
that either.

What you should see is this event code in the activesheet code module

Private Sub myMacro_Click()
If Range("A1").Value > 0 Then
MsgBox "Hi"
End If

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Papa Jonah]

Bob,
I did as you suggested. I got a "run-time error 1004. Programmatic access
to Visual Basic Project is not trusted."
Is this based on some setting somewhere that I can change?

I appreciate your help, Bob.

 

[Chip Pearson]

Go to the Tools menu, choose Macros, then Security, then the
Trusted Publishers tab. There, check the "Trust access to Visual
Basic Project" option.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com


message

 

[Papa Jonah]

Got it!
Thanks Chip and Bob!

Go to the Tools menu, choose Macros, then Security, then the
Trusted Publishers tab. There, check the "Trust access to Visual
Basic Project" option.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com


message

 

[Papa Jonah]

When I created a new file with a new module, Bob's code worked.
However, when I included the code into my file - it stalls.
To see if it would work in my code, I pasted it as is and added a value to
A1 for purposes of testing.
You will see below where it stalls. I get a "Run-time error '9': Subscript
out of range"


Sub CreateControlButton()

Dim oWs As Worksheet
Dim oOLE As OLEObject
Range("a1").Value = 5

Set oWs = ActiveSheet

Set oOLE = _
oWs.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=200, Top:=100, Width:=80, Height:=32)

With oOLE
.Object.Caption = "Run Jonah's Test"
.Name = "myMacro"
End With
'the next line stalls
With ThisWorkbook.VBProject.VBComponents(oWs.CodeName).CodeModule
.InsertLines .CreateEventProc("Click", oOLE.Name) + 1, _
vbTab & "If Range(""A1"").Value > 0 Then " & vbCrLf & _
vbTab & vbTab & "Msgbox ""Hi""" & vbCrLf & _
vbTab & "End If"

End With

End Sub

 

[Bob Phillips]

It's a team thing <g>

Bob

Got it!
Thanks Chip and Bob!

 

[Bob Phillips]

Jonah,

I have just pasted the code as is and it works. What do you mean by stalled?

If you want, you can send the file to me and I will take a look.

--

HTH

RP
(remove nothere from the email address if mailing direct)