4

VBA コードを使用して Excel シートに ActiveX コントロール ラベルを挿入しています。ボタンを挿入した後、クリックイベントコードを挿入しようとしていますが、機能していません。以下はコードです：

Public Function AddButton(strSheetName, counter)
Dim btn As OLEObject
Dim cLeft, cTop, cWidth, cHeight
Dim CodeModule As Object
    With Worksheets(strSheetName).Range("J" & (6 + counter))
        cLeft = .Left + 1
        cTop = .Top + 1
        cWidth = .Width - 2
        cHeight = .Height - 2
    End With
    With Worksheets(strSheetName)
        Set btn = .OLEObjects.Add(ClassType:="Forms.Label.1", Link:=True, DisplayAsIcon:=True, Left:=cLeft, Top:=cTop, Width:=cWidth, Height:=cHeight)
    End With
    btn.Object.Caption = "Add New"
    btn.Name = Left(strSheetName, 3) & counter
    Set CodeModule = ActiveWorkbook.VBProject.VBComponents.VBE.ActiveCodePane.CodeModule
    CodeModule.InsertLines CodeModule.CreateEventProc("Click", btn.Name) + 1, vbTab & "MsgBox ""Hello world"""
End Function

ボタンが挿入されていますが、クリック イベント コードが機能していません。クリックしても何も起こりません。また、この関数はループで呼び出されています。初めてボタンを追加し、クリックイベントコードを追加しようとするとすぐにループが終了します。これはエラーがあることを意味します。

何か助けはありますか？

前もって感謝します。

4

1 に答える 1

3

これは前回の質問の続きだと思います。

これはあなたがしようとしていることですか？

Option Explicit

Sub Sample()
    Dim i As Long

    For i = 1 To 5
        AddButton "Sheet1", i
    Next i
End Sub

Public Sub AddButton(strSheetName As String, counter As Long)
    Dim btn As OLEObject
    Dim cLeft, cTop, cWidth, cHeight

    With Worksheets(strSheetName).Range("J" & (6 + counter))
        cLeft = .Left
        cTop = .Top
        cWidth = .Width
        cHeight = .Height
    End With
    With Worksheets(strSheetName)
        Set btn = .OLEObjects.Add(ClassType:="Forms.Label.1", Link:=True, _
        DisplayAsIcon:=False, Left:=cLeft, Top:=cTop, Width:=cWidth, _
        Height:=cHeight)
    End With
    btn.Object.Caption = "Add New"

    btn.Name = Left(strSheetName, 3) & counter

    With ActiveWorkbook.VBProject.VBComponents( _
    ActiveWorkbook.Worksheets(strSheetName).CodeName).CodeModule
        .InsertLines Line:=.CreateEventProc("Click", btn.Name) + 1, _
        String:=vbCrLf & _
        "MsgBox ""Hello world"""
    End With
End Sub

ファローアップ

はい、Excel プロジェクト全体の特定のシートからコードを消去します。それが要件です – user1269291 54秒前

Option Explicit

Sub Sample()
    Dim strSheetName As String

    strSheetName = "Sheet1"

    With ActiveWorkbook.VBProject.VBComponents( _
    ActiveWorkbook.Worksheets(strSheetName).CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
    End With
End Sub
于 2012-05-17T10:15:01.093 に答える