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
沒有留言:
張貼留言