2012年8月6日 星期一

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

沒有留言:

張貼留言