title image


Smiley Re: Benutzerdefinierte Symbolleiste ausgeben


Der Makro baut jetzt eine volle Tabelle.



Viele Grüße!!!



Chrisir









Option Explicit





Sub MakroFuerMenues()

    

    Dim conMeinControlMenues    As Object       ' Menü

    Dim conMeinControlImMenue   As Object       ' Befehl im Menü

    Dim strMeldung              As String       ' für MsgBox

    Dim strMyTasten             As String       ' für Tasten

    Dim myKey                   As KeyBinding   ' für Tasten

    

    

    On Error GoTo 0



    strMeldung = "Ausgabe der Symbolleiste ""Menu Bar"" : " & _

                 vbNewLine & _

                 "(Kurzfassung)" & _

                 vbNewLine & _

                 vbNewLine

    

    Documents.Add

    

    Selection.Sections(1).Footers(1).PageNumbers.Add PageNumberAlignment:= _

        wdAlignPageNumberRight, FirstPage:=True

    

    With ActiveDocument.PageSetup

        .Orientation = wdOrientLandscape

    End With

    

    Selection.TypeText "Ausgabe der Symbolleiste MenuBar am " & vbNewLine & _

                       Date & " um " & Time & vbNewLine & vbNewLine

                       

    ' Tabelle :

    ActiveDocument.Tables.Add Selection.Range, 1, 7

    

    ActiveDocument.Tables(1).Range.Paragraphs.Alignment = wdAlignParagraphLeft

    ActiveDocument.Tables(1).Rows.Last.Cells(1).Range.Text = "Caption"

    ActiveDocument.Tables(1).Rows.Last.Cells(2).Range.Text = "OnAction"

    ActiveDocument.Tables(1).Rows.Last.Cells(3).Range.Text = "TooltipText"

    ActiveDocument.Tables(1).Rows.Last.Cells(4).Range.Text = "DescriptionText"

    ActiveDocument.Tables(1).Rows.Last.Cells(5).Range.Text = "Parameter"

    ActiveDocument.Tables(1).Rows.Last.Cells(6).Range.Text = "Tag"

    ActiveDocument.Tables(1).Rows.Last.Cells(7).Range.Text = "Taste"

    ActiveDocument.Tables(1).Rows.Last.Range.Bold = True

    ActiveDocument.Tables(1).Rows.Last.Range.Font.Size = "8"

    ActiveDocument.Tables(1).Rows.Add

    ActiveDocument.Tables(1).Rows.Last.Range.Bold = False

    ActiveDocument.Tables(1).Rows.Add

    

    ' Alle Menüs im Menu Bar durchgehen:

    For Each conMeinControlMenues In Application.CommandBars("Menu Bar").Controls

        

        ' Neues Menü :

        ActiveDocument.Tables(1).Rows.Last.Cells(1).Range.Text = "Menü: " & _

                                                                 conMeinControlMenues.Caption

        ActiveDocument.Tables(1).Rows.Last.Cells(1).Range.Bold = True

        

        If conMeinControlMenues.Type = msoControlPopup Then

            

            ActiveDocument.Tables(1).Rows.Add

            ActiveDocument.Tables(1).Rows.Last.Cells(1).Range.Bold = False

            strMeldung = strMeldung & _

                         conMeinControlMenues.Caption & ": "



            ' Befehle in diesem Menü

            For Each conMeinControlImMenue In conMeinControlMenues.Controls

                    

                Application.StatusBar = conMeinControlMenues.Caption & " | " & conMeinControlImMenue.Caption

                ActiveDocument.Windows(1).ScrollIntoView ActiveDocument.Tables(1).Rows.Last.Range

                DoEvents

                

                With ActiveDocument.Tables(1).Rows.Last

                    .Cells(1).Range.Text = conMeinControlImMenue.Caption

                    ' Init:

                    strMyTasten = ""

                    ' Ist es ein eingebauter Menüpunkt?

                    If conMeinControlImMenue.BuiltIn Then

                        .Cells(2).Range.Text = " / "

                        On Error Resume Next

                        strMyTasten = conMeinControlImMenue.ShortcutText

                        On Error GoTo 0

                        .Range.Font.Italic = False

                    Else

                        .Cells(2).Range.Text = conMeinControlImMenue.OnAction

                        ' Tasten auslesen (ggf. mehrere):

                        For Each myKey In KeysBoundTo(KeyCategory:=wdKeyCategoryCommand, _

                                                      Command:=conMeinControlImMenue.OnAction)

                            strMyTasten = strMyTasten & myKey.KeyString & vbCr

                        Next myKey

                        ' kurisv setzen

                        .Range.Font.Italic = True

                    End If

                    .Cells(3).Range.Text = conMeinControlImMenue.TooltipText

                    .Cells(4).Range.Text = conMeinControlImMenue.DescriptionText

                    .Cells(5).Range.Text = conMeinControlImMenue.Parameter

                    .Cells(6).Range.Text = conMeinControlImMenue.Tag

                    .Cells(7).Range.Text = strMyTasten

                End With

                

                ActiveDocument.Tables(1).Rows.Add

                

                strMeldung = strMeldung & conMeinControlImMenue.Caption & _

                             "; "

            

            Next conMeinControlImMenue

            

            strMeldung = strMeldung & vbNewLine & vbNewLine

            ActiveDocument.Tables(1).Rows.Add

        Else

            ActiveDocument.Tables(1).Rows.Last.Cells(2).Range.Text = "Kein Menü."

            ActiveDocument.Tables(1).Rows.Add

            ActiveDocument.Tables(1).Rows.Last.Cells(1).Range.Bold = False

            ActiveDocument.Tables(1).Rows.Add

        End If

        

        ActiveDocument.Tables(1).Rows.Add

     

    Next conMeinControlMenues

                     

    Selection.EndKey unit:=wdStory, Extend:=wdMove

    Application.StatusBar = "Kurzfassung"

    ActiveDocument.Windows(1).ScrollIntoView Selection.Range

    Selection.TypeText vbNewLine & _

                       vbNewLine & _

                       vbNewLine & _

                       strMeldung



    Selection.HomeKey unit:=wdStory, Extend:=wdMove



    

    MsgBox "Fertig. ", _

           vbInformation, _

           "Menübefehle anzeigen"



End Sub





Sub SichtbareSymbolleistenAnzeigen()



    Dim strMeldung              As String

    Dim cmdbarMeinCommandBar    As CommandBar

    

    

    strMeldung = "Sichtbare Symbolleisten: " & vbNewLine & vbNewLine

    

    For Each cmdbarMeinCommandBar In Application.CommandBars

        If cmdbarMeinCommandBar.Visible Then

            strMeldung = strMeldung & cmdbarMeinCommandBar.Name & vbNewLine

        End If

    Next cmdbarMeinCommandBar

    

    MsgBox strMeldung



End Sub









Code eingefügt mit Syntaxhighlighter 2.5





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: