2012年8月6日 星期一

Using VBA to write VBA code (create multiple buttons)

Sub AddComm_button()

Dim myButton As New OLEObject
Dim sCode As String
Dim iX As Integer
Dim CurSheet As Worksheet

Set CurSheet = Worksheets("Sheet1")

For iX = 1 To 2
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
myButton.Left = 126 * iX
myButton.Top = 96
myButton.Width = 126.75
myButton.Height = 25.5

Set myButton = Nothing
Next iX

For iX = 1 To 2
'Code for button
sCode = ""
sCode = "Sub CommandButton" & iX & "_Click()" & vbCrLf
sCode = sCode & " Sheets(""Sheet" & iX & """).Activate" & vbCrLf
sCode = sCode & "End Sub"

'Write code for button
ThisWorkbook.VBProject.VBComponents(CurSheet.Name).Activate

With ThisWorkbook.VBProject.VBComponents(CurSheet.Name).CodeModule
.AddFromString (sCode)
End With

sCode = vbNullString
Next iX

End Sub

SOURCE : http://www.mrexcel.com/archive/VBA/1086.html



MY TRY (It's Work)



Sub CreateButton()

' 可能 出現 "於執行程式碼時出現以下錯誤 - 執行錯誤1004 - 對於VB專案的程式化存取未信任
' 要在 "工具>巨集>安全性 -  信任的來源>信任存取visual basic(v)專案 選項要打V


Dim Obj As Object
Dim Code As String

Sheets("主頁").Select
For i = 1 To 2
    h = 32
'create button
    Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
    Link:=False, DisplayAsIcon:=False, Left:=222, Top:=69 + (i + 1) * h, Width:=158, Height:=26)
    Obj.Name = "File_Button" & i
 
'buttonn text
    ActiveSheet.OLEObjects(i).Object.Caption = "File_Button" & i

'macro text
    Code = "Sub " & "File_Button" & i & "_Click()" & vbCrLf
    Code = Code & "Call Module1.Tester" & vbCrLf
    Code = Code & "End Sub"
'add macro at the end of the sheet module
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        .insertlines .CountOfLines + 1, Code
    End With
Next i
End Sub

Sub Tester()
    MsgBox "You have click on the test button"
End Sub


Sub Remove_Codes_in_Module()

' remove all code in a Module

Sheets("主頁").Select
 With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With

End Sub

Sub AddComm_button()

' Using VBA to write VBA code (create multiple buttons)

Dim myButton As New OLEObject
Dim sCode As String
Dim iX As Integer
Dim CurSheet As Worksheet

x = Sheets("File總表").Range("d1").Value   ' Buttom no.


Set CurSheet = Worksheets("主頁")
Sheets("主頁").Select
For i = 1 To x
    h = 32

Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
myButton.Left = 222
myButton.Top = 69 + (i - 1) * h
myButton.Width = 158
myButton.Height = 26

myButton.Name = "File_Button" & i
ActiveSheet.OLEObjects(i).Object.Caption = "File_Button" & i

Set myButton = Nothing

Next i

For iX = 1 To x
'Code for button
sCode = ""
sCode = "Sub CommandButton" & iX & "_Click()" & vbCrLf
' sCode = sCode & " Sheets(""Sheet" & iX & """).Activate" & vbCrLf
sCode = sCode & "End Sub"

'Write code for button
ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).Activate

With ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).CodeModule
.AddFromString (sCode)
End With

sCode = vbNullString
Next iX

End Sub




沒有留言:

張貼留言