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

在 vba module 中 delete 所有 code

Sub test()

' remove all code in a Module

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

End Sub

VBA 加 BUTTOM 並加 CODE

Adding a VBA CommandButton with its respective the code

Paste these two sections of code into a general module (Module1 for example). 

Sub CreateButton()           

Dim Obj As Object           
Dim Code As String           

Sheets("Sheet1").Select           

'create button           
    Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _           
    Link:=False, DisplayAsIcon:=False, Left:=200, Top:=100, Width:=100, Height:=35)           
    Obj.Name = "TestButton"           
'buttonn text           
    ActiveSheet.OLEObjects(1).Object.Caption = "Test Button"           

'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 ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule           
        .insertlines .CountOfLines + 1, Code           
    End With           
End Sub           

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

於執行程式碼時出現以下錯誤
執行錯誤1004 
對於VB專案的程式化存取未信任

ANSWER
工具>巨集>安全性
信任的來源>信任存取visual basic(v)專案
選項要打V

MY WORK :

Sub Set_Buttons_Codes()

' 建立按鍵後的程式


x = Sheets("File總表").Range("d1").Value   ' Button 需要的數量

For iX = 1 To x

a = Cells(4 + iX, 4).Value ' File Exist or not
b = Cells(4 + iX, 5).Value ' File Open or not
c = Application.WorksheetFunction.VLookup(iX, Range("File總表!A4:e100"), 4, False) ' FILE名
d = Application.WorksheetFunction.VLookup(iX, Range("File總表!A4:e100"), 3, False) ' file路徑

If a = "Y" Then

'Code for button(沒有此檔案)
sCode = ""
sCode = "Sub File_Button" & iX & "_Click()" & vbCrLf
sCode = sCode & "' 沒有此檔案 " & vbCrLf
sCode = sCode & "' NOTHING TO DO  " & vbCrLf
sCode = sCode & "End Sub"

ElseIf b = "Y" Then

'Code for button(檔案已開啟)
sCode = ""
sCode = "Sub File_Button" & iX & "_Click()" & vbCrLf
sCode = sCode & "' 檔案已開啟 " & vbCrLf
sCode = sCode & "Windows(" & Chr(34) & c & Chr(34) & ").Activate" & vbCrLf
sCode = sCode & "End Sub"
 
Else

'Code for button(檔案存在 , 但未開啟)
sCode = ""
sCode = "Sub File_Button" & iX & "_Click()" & vbCrLf
sCode = sCode & "' 檔案存在 , 但未開啟 " & vbCrLf
sCode = sCode & "Workbooks.Open Filename:= _" & vbCrLf
sCode = sCode & Chr(34) & d & "\" & c & Chr(34) & vbCrLf
sCode = sCode & "End Sub"


End If

'Write code for button(IN SHEET2)
ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).Activate

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

'add macro at the end of the sheet module
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        .InsertLines .CountOfLines + 1, sCode
    End With

sCode = vbNullString

Next iX

End Sub