Создать командную кнопку и назначить ей событие в программе - PullRequest
Новая
       40

Создать командную кнопку и назначить ей событие в программе

3 голосов
/ 24 ноября 2011

Я нашел этот код в сети и немного его подправил, чтобы программно добавить командную кнопку в электронную таблицу и назначить ей событие.Это хорошо работает 

Sub AddComm_button()
  Set mybutton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
    Left:=126, Top:=96, Width:=126.75, Height:=25.5)
  mybutton.Name = "abcbutton"
  Call Modify_CommButton
End Sub

Sub Modify_CommButton()
  Dim LineNum As Long 'Line number in module
  Dim SubName As String 'Event to change as text
  Dim Proc As String 'Procedure string
  Dim EndS As String 'End sub string
  Dim Ap As String 'Apostrophe
  Dim Tabs As String 'Tab
  Dim LF As String 'Line feed or carriage return

  Ap = Chr(34)
  Tabs = Chr(9)
  LF = Chr(13)
  EndS = "End Sub"
  SubName = "Private Sub abcbutton_Click()" & LF
  Proc = Tabs & "MsgBox " & Ap & "Testing " & Ap & LF
  Proc = Proc & "End Sub" & LF
  Set ModEvent = ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule
  With ModEvent
    LineNum = .CountOfLines + 1
    .InsertLines LineNum, SubName & Proc & EndS  
  End With
End Sub

Следующий код добавляет мою оригинальную программу с этим 

Private Sub abcbutton_Click()
   MsgBox "Testing "
End Sub

и, следовательно, дает ей событие click.Как удалить добавленную часть после завершения моей программы.Прямо сейчас, когда я запускаю свою программу во второй раз, в ней уже есть метод abcbutton_Click (), и он выдает ошибку.

Спасибо Оригинальный источник: http://www.mrexcel.com/archive/VBA/5348a.html

1 Ответ

6 голосов
/ 24 ноября 2011

Я думаю, вам нужно убедиться, что кнопка добавляется только один раз. 

Sub AddComm_button()
    Dim obj As OLEObject
    Dim fFoundIt As Boolean = False
    For Each obj In ActiveSheet.OLEObjects
        If TypeOf obj.Object Is MSForms.CommandButton Then
            If obj.Name = "abcbutton" Then
                fFoundIt = True
                Exit For
            End If
        End If
    Next

    If Not fFoundIt Then
       Set mybutton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1",Left:=126, Top:=96, Width:=126.75, Height:=25.5)
       mybutton.Name = "abcbutton"
       Call Modify_CommButton
    End if
End Sub

Кроме того, у вас есть опечатка в вашем суб-создании: 

Proc = Proc & "End If" & LF

должно быть 

Proc = Proc & "End Sub" & LF

Обновление методом удаления кода 

Sub RemoveProcedure(sProcedureName As String)

    Set ModEvent = ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule

    Dim wCurrLine As Integer
    Dim wFirstLine As Integer

    ' See if the method name exists
    For wCurrLine = 1 To ModEvent.CountOfLines
        Dim sCurrLine As String
        sCurrLine = ModEvent.Lines(wCurrLine, 1)
        If InStr(1, sCurrLine, sProcedureName, vbTextCompare) > 0 Then
            wFirstLine = wCurrLine
            Exit For
        End If
    Next

    ' If it does exist, remove it
    If wFirstLine <> 0 Then
        ' Start on the line after the first line
        For wCurrLine = wFirstLine + 1 To ModEvent.CountOfLines
            Dim sCurrLine As String
            sCurrLine = ModEvent.Lines(wCurrLine, 1)
            ' Found end sub
            If InStr(1, sCurrLine, "End Sub", vbTextCompare) > 0 Then
                ' So delete the lines
                ModEvent.DeleteLines wFirstLine, (wCurrLine + 1) - wFirstLine
                Exit For
            End If
        Next
    End If

End Sub
...