PDA

View Full Version : [SOLVED] Creating two buttons and code programmatically



Paleo
02-01-2005, 08:42 PM
I need to create two buttons (at the same time) and add code to them. Not the same code for both. Each one must call a sub. I know how to add a code to the first button or add code to subsequente buttons, but only if i run the code twice and i need them to be added both the first time i run the code. Tried for ... next already but didnt succeed.

Any suggestions?

Ken Puls
02-01-2005, 09:07 PM
Hi Carlos,

Nate Oliver helped me with this one a while ago. You should be able to modify the button names and procedure names to suit. Remember to set a reference to the VBA Extensibility Library and also to ensure that you've trusted access to the VB Project. (Tools|Options|Security|Macro Security|Trusted Publishers... or something like that!)


Sub Add_Command_Buttons()
'Macro purpose: To create 2 pre-formatted command buttons on the worksheet
'SECTION 1
'Declare required variables and working environment
Dim cl As Range, ctrl As OLEObject, i, LineNum As Integer
Dim TargetSheet As Worksheet, TargetBook As Workbook
Application.ScreenUpdating = False
Set TargetSheet = ActiveSheet
Set TargetBook = ActiveWorkbook
'SECTION 2
'Add preformated buttons to worksheet
For Each cl In [A1,I1] 'update this range to place buttons
i = i + 1
Set ctrl = TargetSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=cl.Left + 1, Top:=cl.Top + 1, Width:=Choose(i, 48, 72.75), Height:=56.25)
With ctrl
.Name = Choose(i, "RollForward", "PrintAll_Standard")
.Placement = xlMove
.PrintObject = False
With .Object
.BackColor = Choose(i, &HC0FFC0, &HFFC0C0)
.Caption = Choose(i, "Roll Forward To New Month", _
"Print Working Paper & AJE")
.Enabled = True
.Font.Name = "Times New Roman"
.Font.Size = 10
.Font.Bold = True
.TakeFocusOnClick = False
.WordWrap = True
End With
End With
Next
'TargetBook.VBProject.VBComponents.Add(1) 'to add a new Module1
With TargetBook.VBProject.VBComponents(TargetSheet.CodeName).CodeModule
LineNum = .CountOfLines + 1
.InsertLines LineNum, _
"Private Sub RollForward_Click()" & vbLf & _
" Msgbox ""Here is the new procedure"" " & vbLf & _
"End Sub"
End With
With TargetBook.VBProject.VBComponents(TargetSheet.CodeName).CodeModule
LineNum = .CountOfLines + 1
.InsertLines LineNum, _
"Private Sub PrintAll_Standard_Click()" & vbLf & _
" Msgbox ""Here is the new procedure"" " & vbLf & _
"End Sub"
End With
Application.ScreenUpdating = True
End Sub

Paleo
02-02-2005, 08:09 AM
Hi Ken,

gee this is great! Exactly what I needed. Of course now I will try to alter it a bit as now I want to add 3 buttons, but reading the code believe its gonna be easy.

Thank you very much!

Paleo
02-02-2005, 08:37 AM
Hi again Ken,

worked just fine, this is my final code:



Sub Add_Command_Buttons()
Dim cl As Range, myCmdObj As OLEObject, i, LineNum As Integer
Dim TargetSheet As Worksheet, TargetBook As Workbook
Application.ScreenUpdating = False
Set TargetSheet = ActiveSheet
Set TargetBook = ActiveWorkbook
For Each cl In [A14,A20,A25]
i = i + 1
Set myCmdObj = TargetSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=cl.Left + 1, Top:=cl.Top + 1, Width:=202.5, Height:=32.25)
With myCmdObj
.Name = Choose(i, "cmdReexibirNC", "cmdSubtotalNC", "cmdResumo")
.Placement = xlMove
.PrintObject = False
With .Object
.Caption = Choose(i, "Reexibe todas colunas e remove subtotais", _
"Gera subtotais e oculta colunas", _
"Analisa outras opera??es")
.Enabled = True
.Font.Size = 10
.Font.Bold = True
.TakeFocusOnClick = False
.WordWrap = True
End With
End With
Next
Set myCmdObj = Nothing
With TargetBook.VBProject.VBComponents(TargetSheet.CodeName).CodeModule
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Private Sub cmdReexibirNC_Click()"
.InsertLines LineNum + 1, vbNewLine
.InsertLines LineNum + 2, vbTab & "Reexibe_NC"
.InsertLines LineNum + 3, vbNewLine
.InsertLines LineNum + 4, "End Sub"
End With
With TargetBook.VBProject.VBComponents(TargetSheet.CodeName).CodeModule
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Private Sub cmdSubtotalNC_Click()"
.InsertLines LineNum + 1, vbNewLine
.InsertLines LineNum + 2, vbTab & "Subtotal_NC"
.InsertLines LineNum + 3, vbNewLine
.InsertLines LineNum + 4, "End Sub"
End With
With TargetBook.VBProject.VBComponents(TargetSheet.CodeName).CodeModule
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Private Sub cmdResumo_Click()"
.InsertLines LineNum + 1, vbNewLine
.InsertLines LineNum + 2, vbTab & "Analisa"
.InsertLines LineNum + 3, vbNewLine
.InsertLines LineNum + 4, "End Sub"
End With
Application.ScreenUpdating = True
End Sub

Ken Puls
02-02-2005, 09:36 AM
Glad it worked!

Paleo
02-02-2005, 11:18 AM
Please ignore this thread, I have posted it here http://www.vbaexpress.com/forum/showthread.php?p=14586#post14586, answer there please.: pray2:

Hi,

gee here I am again. Another problem. I need to put the buttons side by side and bellow a row I dont know which is.

I tried this:


For Each cl In [replace(Range("B65536").End(xlUp).Address,"$",""), replace(Range("D65536").End(xlUp).Address,"$",""), replace(Range("H65536").End(xlUp).Address,"$","")]


Didnt work. Any suggestions?

Paleo
02-02-2005, 11:59 AM
This one is already solved, just read the previous, please.

This is the one I wanna change and t has another error. Two buttons are being positioned one above another. The ones from column "B".



For Each cl In [B5664,B5668,H5664] 'update this range to place buttons
i = i + 1
Set myCmdObj = TargetSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=cl.Left + 1, Top:=cl.Top + 1, Width:=202.5, Height:=32.25)


Any suggestions about this thread and the one before it?