none
Menübefehle funktionieren nicht mehr nach VBIDE-Zugriff

    Frage

  • Hallo Peter!<o:p></o:p>

    Ich hatte dich am Bratwurstabend der SNEK darauf angesprochen: - hier der Code:<o:p></o:p>

    erst mal das Modul:<o:p></o:p>

    Option Compare Database<o:p></o:p>

    Private MenuEvent As CVBECommandHandler

    Private CmdBarItem As CommandBarControl

    Private EventHandlers As New Collection<o:p></o:p>

    Private Const C_INDENT = 4<o:p></o:p>

    '''''''''''''''''''''''''''''''''''''''''''''''''

    ' The C_TAG constant is used to identify controls

    ' added by this project. You should change the

    ' value of this constant to something unique. It

    ' will be used to delete the controls when the

    ' workbook is closed and the project is unloaded.

    '''''''''''''''''''''''''''''''''''''''''''''''''

    Private Const C_TAG = "MY_VBE_TAG"<o:p></o:p>

    Sub AddNewVBEControls()<o:p></o:p>

    Dim Ctrl As Office.CommandBarControl<o:p></o:p>

    '''''''''''''''''''''''''''''''''''''''''''''''''

    ' Delete any existing controls with our Tag.

    '''''''''''''''''''''''''''''''''''''''''''''''''

    Set Ctrl = Application.VBE.CommandBars.FindControl(Tag:=C_TAG)

    Do Until Ctrl Is Nothing

        Ctrl.Delete

        Set Ctrl =
    Application.VBE.CommandBars.FindControl(Tag:=C_TAG)

    Loop<o:p></o:p>

    '''''''''''''''''''''''''''''''''''''''''''''''''

    ' Delete any existing event handlers.

    '''''''''''''''''''''''''''''''''''''''''''''''''

    Do Until EventHandlers.Count = 0

        EventHandlers.Remove 1

    Loop<o:p></o:p>

    '''''''''''''''''''''''''''''''''''''''''''''''''

    ' add the first control to the Tools menu.

    '''''''''''''''''''''''''''''''''''''''''''''''''

    Set MenuEvent = New CVBECommandHandler

    With Application.VBE.CommandBars("Menüleiste").Controls("Extras")

        Set CmdBarItem = .Controls.Add

    End With

    With CmdBarItem

        .Caption = "First Item"

        .BeginGroup = True

        .OnAction = "Procedure_One"

        .Tag = C_TAG

    End With<o:p></o:p>

    Set MenuEvent.EvtHandler = Application.VBE.Events.CommandBarEvents(CmdBarItem)

    EventHandlers.Add MenuEvent<o:p></o:p>

    '''''''''''''''''''''''''''''''''''''''''''''''''

    ' add the second control to the Tools menu.

    '''''''''''''''''''''''''''''''''''''''''''''''''

    Set MenuEvent = New CVBECommandHandler

    With Application.VBE.CommandBars("Menüleiste").Controls("Extras")

        Set CmdBarItem = .Controls.Add

    End With

    With CmdBarItem

        .Caption = "Second Item"

        .BeginGroup = False

        .OnAction = "Procedure_Two"

        .Tag = C_TAG

    End With<o:p></o:p>

    Set MenuEvent.EvtHandler = Application.VBE.Events.CommandBarEvents(CmdBarItem)

    EventHandlers.Add MenuEvent<o:p></o:p>

    '''''''''''''''''''''''''''''''''''''''''''''''''

    ' add the third control to the Tools menu.

    '''''''''''''''''''''''''''''''''''''''''''''''''

    Set MenuEvent = New CVBECommandHandler

    With
    Application.VBE.CommandBars("Menüleiste").Controls("Extras")

        Set CmdBarItem = .Controls.Add

    End With

    With CmdBarItem

        .Caption = "Format Lines"

        .BeginGroup = True

        .OnAction = "FormatLines"

        .Tag = C_TAG

    End With<o:p></o:p>

    Set MenuEvent.EvtHandler = Application.VBE.Events.CommandBarEvents(CmdBarItem)

    EventHandlers.Add MenuEvent<o:p></o:p>

    End Sub<o:p></o:p>

    Sub DeleteMenuItems()

    '''''''''''''''''''''''''''''''''''''''''''''''''''''

    ' This procedure deletes all controls that have a

    ' tag of C_TAG.

    '''''''''''''''''''''''''''''''''''''''''''''''''''''

        Dim Ctrl As Office.CommandBarControl

        Set Ctrl =
    Application.VBE.CommandBars.FindControl(Tag:=C_TAG)

        Do Until Ctrl Is Nothing

            Ctrl.Delete

            Set Ctrl =
    Application.VBE.CommandBars.FindControl(Tag:=C_TAG)

        Loop

    End Sub<o:p></o:p>

    Public Sub Procedure_One()

        MsgBox "Procedure One"

    End Sub<o:p></o:p>

    Public Sub Procedure_Two()

        MsgBox "Procedure Two"

    End Sub<o:p></o:p>

    Public Sub Auto_Open()

        AddNewVBEControls

    End Sub<o:p></o:p>

    Public Sub Auto_Close()

        DeleteMenuItems

    End Sub<o:p></o:p>

    Public Sub FormatLines()

        Dim objcm As CodeModule

        Dim lngStartLine As Long, lngEndLine As Long

        Dim lngStartColumn As Long, lngEndColumn As Long

        Dim strSelection As String

        Dim strWork As String

        Dim i As Long

        Dim lngIndent As Long

        Set objcm = VBE.ActiveCodePane.CodeModule

        VBE.ActiveCodePane.GetSelection lngStartLine, lngStartColumn, lngEndLine, lngEndColumn<o:p></o:p>

        For i = lngStartLine To lngEndLine

        If i = lngStartLine Then

            strSelection = objcm.Lines(i, 1)

            Do While Left(strSelection, 1) = " "

            lngIndent = lngIndent + 1

            strSelection = Mid(strSelection, 2)

            Loop

            lngIndent = lngIndent / C_INDENT

            strSelection = Trim(strSelection)

            Else

            strSelection = Trim(objcm.Lines(i, 1))

        End If

        strWork = String(lngIndent * C_INDENT, " ") & strSelection

        If Left(strSelection, 3) = "If " Then lngIndent = lngIndent + 1

        If InStr(6, strSelection, " then ") And Right(Trim(strSelection), 4) <> "Then" Then lngIndent = lngIndent
    - 1

        If Left(strSelection, 6) = "End If" Then

        lngIndent = lngIndent - 1

        strWork = String(lngIndent * C_INDENT, " ") & strSelection

        End If

        Debug.Print strWork

        'objcm.ReplaceLine i, strWork

        Next<o:p></o:p>

    End Sub<o:p></o:p>

    und jetzt
    noch die Klasse:<o:p></o:p>



    Private Sub EvtHandler_Click(ByVal CommandBarControl
    As Object, _

        Handled As Boolean, CancelDefault As Boolean)

        '''''''''''''''''''''''''''''''''''''''''''''''''''''

        ' This is called when a item is clicked. Call the

        ' procedure named in the OnAction property of the

        ' CommandBarControl passed into this procedure.

        '''''''''''''''''''''''''''''''''''''''''''''''''''''

       

        On Error Resume Next

        Application.Run CommandBarControl.OnAction

        '''''''''''''''''''''''''''''''''''''''''''''''''''''

        ' Tell VBIDE that we've handled the event.

       
    '''''''''''''''''''''''''''''''''''''''''''''''''''''

        Handled = False

        CancelDefault = False

    End Sub<o:p></o:p>

    Ich kann
    bei dem Projket nicht an die Registry und daher auch kein Add-In erstellen,
    deshalb habe ich die Menü-Items einfach mit normalem Code erzeugt. Klappt auch.<o:p></o:p>

    Mit
    Auto_Open erzeuge ich zwei Dummy-Items, dann das Item FormatLines, welches auch
    die entsprechende Prozedur aufruft.<o:p></o:p>

    Wie du siehst, ist das fette ReplaceLine auskommentiert. Lässt man das Ganze laufen,
    funktioniert alles wunderbar, der markierte Code wird formatiert (in diesem
    Testzustand wird nur IF/End If betrachtet, damit es übersichtlicher bleibt) und als Debug
    ausgegeben. Und das auch problemlos mehrmals hintereinander.<o:p></o:p>

    Jetzt kommt das Problem. Wenn ich das ReplaceLine wieder in das Programm nehme -
    funktioniert alles wunderbar, aber nur genau einmal. Rufe ich die Prozedur
    erneut auf, dann tut sich gar nichts mehr.<o:p></o:p>

    Dann mache ich ein Auto-Open, die Befehle werden gelöscht und neu erzeugt, und alles
    funktioniert.<o:p></o:p>

    Einmal.<o:p></o:p>

    Hast Du
    eine Idee????<o:p></o:p>

    Grüße<o:p></o:p>

    Roland<o:p></o:p>



    It's no problem, it's just the syntax

    Montag, 22. April 2013 05:38