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