title image


Smiley Re: Benutzerdefinierte Symbolleiste ausgeben


Hallo !



Ich finde dieses Makro- und Symboleisten Geschiebe auch

nervig. Du hast völlig Recht!



Hier ist noch ein Makro.

Er erzeugt eine Tabelle.

Der Trick: Man kann die Werte in der Tabelle doppelt anklicken und Sie so ändern.

Beispiel:

Du klickst in die OnAction-Spalte und änderst den OnAction-Wert.

Du klickst in die Caption-Spalte und änderst den Caption-Wert.



Das Dokument mit der Tabelle ist danach veraltet und kann gelöscht werden - man kann es ja jederzeit neu generieren.





Viele Grüße, Christoph





____









Option Explicit



' Modul für CommandBars und Buttons in einer Tablle mit Feldern

'

' Es geht um das Editieren von Makroschaltflächen in den Symbolleisten.

'

' Modul erzeugt ein Dokument mit

' Makrobuttons und Dokumentenvariablen (CmdBarAusgabe_Tabelle),

' das eine Tabelle mit Feldern enthält, die anklickbar sind,

' so dass man die Button-Eigenschaften editieren kann

' (via EditiereButtonWerteJeNachTabellenZelle).

'

' Das Modul ist zweiteilig:

' Teil 1: Hier sind zwei subs zum Erzeugen des Dokuments;

' Teil 2: Hier sind eine sub und eine Function für die Funktionalität der Felder im

'         Dokument.



' ********************************************************************************

' Thema CommandBars (Symbolleisten) und die Buttons darauf in Tabelle ablegen

' ********************************************************************************





Sub CmdBarAusgabe_Tabelle()

    

    ' Geht alle sichtbaren und aktivierten Symbolleisten durch und

    ' erstellt eine Tabelle mit Feldern.

    

    ' Wird manuell gestartet.



    Dim aCommandBar1  As CommandBar

    Dim Antwort       As Integer

    Dim intNumTable1  As Integer

    

    ' Legt fest, welches die Dokumentvorlage oder das Dokument darstellt,

    ' in dem Änderungen der Menüleisten, Symbolleisten und Tastenbelegungen

    ' gespeichert sind :

'     CustomizationContext = Application.Templates("Normal.dot")

    ' z.B. ActiveDocument

    '      "C:\Dokumente und Einstellungen\Pfad\Makros1.dot"

    '      .AttachedTemplate

    '      Application.Templates("Normal.dot")

    '      ActiveDocument.AttachedTemplate

    

    MsgBox "Bitte passen Sie den CustomizationContext im Makro an.", _

           vbInformation

    

    Application.Documents.Add

    

    With ActiveDocument.PageSetup

        .LineNumbering.Active = False

        .Orientation = wdOrientLandscape

        .TopMargin = CentimetersToPoints(2.5)

        .BottomMargin = CentimetersToPoints(2.5)

        .LeftMargin = CentimetersToPoints(2.5)

        .RightMargin = CentimetersToPoints(2)

        .Gutter = CentimetersToPoints(0)

        .HeaderDistance = CentimetersToPoints(1.25)

        .FooterDistance = CentimetersToPoints(1.25)

        .PageWidth = CentimetersToPoints(29.7)

        .PageHeight = CentimetersToPoints(21)

        .FirstPageTray = wdPrinterDefaultBin

        .OtherPagesTray = wdPrinterDefaultBin

        .SectionStart = wdSectionNewPage

        .OddAndEvenPagesHeaderFooter = False

        .DifferentFirstPageHeaderFooter = False

        .VerticalAlignment = wdAlignVerticalTop

        .SuppressEndnotes = False

        .MirrorMargins = False

        .TwoPagesOnOne = False

        .GutterPos = wdGutterPosLeft

    End With

    

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

        wdAlignPageNumberRight, FirstPage:=True

    

    Selection.TypeText "Am " & Date & " um " & Time & _

                       vbNewLine

    Selection.TypeText "Die sichtbaren Ausgangswerte in der Tabelle werden bei Änderungen nicht angepasst." & _

                       vbNewLine & vbNewLine

    

    intNumTable1 = 0

    

    ' Geht alle Symbolleisten durch

    For Each aCommandBar1 In Application.CommandBars

        

        ' Symbolleiste: sichtbar und aktiviert ?

        If aCommandBar1.Visible And _

           aCommandBar1.Enabled Then

                

                ' neue Symbolleiste / neue Überschrift :

                Selection.TypeParagraph

                Selection.Font.Bold = True

                Selection.TypeText "Symbolleiste: " & aCommandBar1.Name & _

                                   vbNewLine & vbNewLine

                Selection.Font.Bold = False

                Selection.TypeParagraph

                

                ' neue Tabelle

                Selection.Tables.Add Selection.Range, 1, 4

                intNumTable1 = intNumTable1 + 1

                Selection.Font.Bold = True

                Selection.TypeText "Caption"

                Selection.Font.Bold = False

                Selection.TypeText " "

                Selection.MoveRight unit:=wdCell

                Selection.Font.Bold = True

                Selection.Range.HighlightColorIndex = wdYellow

                Selection.TypeText "Tool Tipp"

                Selection.Range.HighlightColorIndex = wdAuto

                Selection.Font.Bold = False

                Selection.TypeText " "

                Selection.MoveRight unit:=wdCell

                Selection.Font.Bold = True

                Selection.TypeText "OnAction"

                Selection.Font.Bold = False

                Selection.TypeText " "

                Selection.MoveRight unit:=wdCell

                Selection.Font.Bold = True

                Selection.TypeText "Description"

                Selection.Font.Bold = False

                Selection.TypeText " "

                Selection.MoveRight unit:=wdCell

                Selection.Font.Bold = False

                

                

                Call ToolTipText_Editor_Helper(aCommandBar1.Name, intNumTable1)

                

                ' Tabelle beenden

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

                Selection.TypeParagraph

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

        

        End If

    

    Next aCommandBar1 ' nächste Symbolleiste



    Selection.HomeKey unit:=wdStory, _

                      Extend:=wdMove

    

    MsgBox " - Fertig - ", _

           vbInformation, _

           "Geht Symbolleisten durch und erstellt eine Tabelle."



End Sub



Private Sub ToolTipText_Editor_Helper(Name1 As String, intNumTable1 As Integer)



    ' Diese sub wird von Sub ToolTipText_Editor()

    ' mit dem Namen der Symbolleiste aufgerufen.

    ' Sie geht alle Buttons der Symbolleiste durch

    ' und fragt ggf., ob man den Tool-Tip ändern will.

    ' Wenn ja, taucht eine Inputbox auf, um das zu tun.

    ' Wenn Abbruch dann Abbruch.

    ' Wenn Nein, dann nächste.

    '

    ' Gefragt wird übrigens überhaupt nur bei Buttons (nicht bei anderen Controls!)

    ' und nur dann, wenn es sich nicht um einen eingebauten

    ' Button handelt.

    

    ' Wird von CmdBarAusgabe_Tabelle verwendet



    Const MakroName = "EditiereButtonWerteJeNachTabellenZelle"



    Dim aButton1    As CommandBarControl

    Dim Antwort     As Integer

    Dim Dummy1      As Field



    

    For Each aButton1 In Application.CommandBars.Item(Name1).Controls

        

        ' Abfrage: bei Buttons (nicht bei anderen Controls!)

        ' und nur dann, wenn es sich nicht um einen eingebauten

        ' Word-Button handelt (also nur bei selbst eingebauten).

        ' zwei Alternativen: alle oder nur benutzerdefinierte Buttons

        ' alle:

        ' If aButton1.Type = msoControlButton Then

        ' nur benutzerdefinierte Buttons

        If aButton1.Type = msoControlButton And Not aButton1.BuiltIn Then

           

           Selection.Font.Bold = False

           Selection.TypeText aButton1.Caption

           Selection.TypeText vbNewLine

           Set Dummy1 = Selection.Fields.Add(Range:=Selection.Range, _

                                             Type:=wdFieldEmpty, _

                                             Text:="MACROBUTTON " & MakroName & " " + _

                                                   "Ändern", _

                                             PreserveFormatting:=False)

           ActiveDocument.Variables.Add Trim(Str(intNumTable1)) & "_" & _

                                        Trim(Str(Selection.Information(wdEndOfRangeColumnNumber))) & _

                                        "_" & _

                                        Trim(Str(Selection.Information(wdEndOfRangeRowNumber))), _

                                        Name1 & "#" & aButton1.Caption & "#Caption"

                                        

           Selection.MoveRight unit:=wdCell

           Selection.Font.Bold = False

           

           Selection.Range.HighlightColorIndex = wdYellow

           Selection.TypeText aButton1.TooltipText



           Selection.Range.HighlightColorIndex = wdAuto

           Selection.TypeText vbNewLine

           Set Dummy1 = Selection.Fields.Add(Range:=Selection.Range, _

                                             Type:=wdFieldEmpty, _

                                             Text:="MACROBUTTON " & MakroName & " " + _

                                                   "Ändern", _

                                                   PreserveFormatting:=False)

           ActiveDocument.Variables.Add Trim(Str(intNumTable1)) & "_" & _

                                        Trim(Str(Selection.Information(wdEndOfRangeColumnNumber))) & _

                                        "_" & _

                                        Trim(Str(Selection.Information(wdEndOfRangeRowNumber))), _

                                        Name1 & "#" & aButton1.Caption & "#TooltipText"

           

           Selection.MoveRight unit:=wdCell

           Selection.Font.Bold = False

           

           Selection.TypeText aButton1.OnAction

           Selection.TypeText vbNewLine

           Set Dummy1 = Selection.Fields.Add(Range:=Selection.Range, _

                Type:=wdFieldEmpty, Text:= _

                "MACROBUTTON " & MakroName & " " + "Ändern", _

                PreserveFormatting:=False)

           ActiveDocument.Variables.Add Trim(Str(intNumTable1)) & "_" & _

                                        Trim(Str(Selection.Information(wdEndOfRangeColumnNumber))) & _

                                        "_" & _

                                        Trim(Str(Selection.Information(wdEndOfRangeRowNumber))), _

                                        Name1 & "#" & aButton1.Caption & "#OnAction"



           Selection.MoveRight unit:=wdCell

           Selection.Font.Bold = False

           

           Selection.TypeText aButton1.DescriptionText

           Selection.TypeText vbNewLine

           Selection.Font.Bold = False

           Set Dummy1 = Selection.Fields.Add(Range:=Selection.Range, _

                Type:=wdFieldEmpty, _

                Text:= _

                "MACROBUTTON " & MakroName & " " + "Ändern", _

                PreserveFormatting:=False)

           ActiveDocument.Variables.Add Trim(Str(intNumTable1)) & "_" & _

                                        Trim(Str(Selection.Information(wdEndOfRangeColumnNumber))) & _

                                        "_" & _

                                        Trim(Str(Selection.Information(wdEndOfRangeRowNumber))), _

                                        Name1 & "#" & aButton1.Caption & "#DescriptionText"

           Selection.MoveRight unit:=wdCell

           

         End If

    

    Next aButton1



End Sub



' ********************************************************************************

'         ENDE   -    Thema CommandBars (Symbolleisten) und die Buttons darauf

'                           in Tabelle ablegen

' ********************************************************************************





'  ************************************************************************

'  Folgendes wird aus der eben erzeugten Tabelle per Doppelklick gestartet



Public Sub EditiereButtonWerteJeNachTabellenZelle()



    ' Wird durch die Felder der Tabelle gestartet.



    Const strTitle = "Werte der Buttons in den Symbolleisten ändern"



    Dim intI

    Dim NumTable

    Dim aVar As Variable

    Dim varMyVar As Variable

    Dim strAntwort As String

    

    Dim strMyVarValue

    Dim strMyKommando

    Dim strMyCmdBar

    Dim strMyControl

    Dim MyArray

    Dim strFrage

    Dim strOldName          As String

    

    

    ' Ggf. Abbruch!

    NumTable = NummerDerAktuellenTabelleImDokument(strTitle)

    

    ' Variable auslesen

    ' (Name variiert je nach doppeltgeklickter Pos in der Tabelle)

    ' Name der DokVar ergibt sich aus Tabellennr., Spaltennr. und Zeilennr. der geklickten Zelle

    strMyVarValue = ActiveDocument.Variables(Trim(Str(NumTable)) & "_" & _

                          Trim(Str(Selection.Information(wdEndOfRangeColumnNumber))) & _

                          "_" & _

                          Trim(Str(Selection.Information(wdEndOfRangeRowNumber))))

    

    ' diese Variable parsen

    MyArray = Split(strMyVarValue, "#", -1)

    

    ' diese Werte, die aus dem Parsing stammen, übernehmen

    strMyCmdBar = MyArray(0)

    strMyControl = MyArray(1)  ' Caption des Controls

    strMyKommando = MyArray(2)

    

    strFrage = "Drücken Sie ggf. Abbrechen. Wollen Sie folgenden Wert ändern? "

    

    ' Je nach Kommando aus der Dokumentenvariable

    ' verschiedene Daten zum Editieren anbieten.

    With ActiveDocument.CommandBars(strMyCmdBar).Controls(strMyControl)

    

        Select Case LCase(strMyKommando)

            Case "caption"

                strOldName = .Caption

                strAntwort = InputBox(strFrage + "(Caption)", strTitle, .Caption)

                If strAntwort <> "" And _

                   strAntwort <> strOldName Then

                    ' Ändern

                    .Caption = Trim(strAntwort)

                    ' Sonderfall: da die Caption des Buttons benutzt wird, um diesen anzusprechen,

                    ' muss der Name in allen DokVars (dieser Symbolleiste) geändert

                    ' werden (dies ist bei den anderen

                    ' Cases nicht nötig):

                    For Each varMyVar In ActiveDocument.Variables

                        If InStr(1, varMyVar.Value, strOldName) > 0 Then

                            ' alter Value, aber neue Caption im Value

                            varMyVar.Value = Replace(varMyVar.Value, _

                                                     strMyCmdBar & "#" & strOldName & "#", _

                                                     strMyCmdBar & "#" & .Caption & "#")

                        End If

                    Next varMyVar



                End If

                

            Case "tooltiptext"

                strAntwort = InputBox(strFrage + "(ToolTip)", strTitle, .TooltipText)

                If strAntwort <> "" Then .TooltipText = Trim(strAntwort)

                

            Case "onaction"

                strAntwort = InputBox(strFrage + "(OnAction)", strTitle, .OnAction)

                If strAntwort <> "" Then .OnAction = Trim(strAntwort)

                

            Case "descriptiontext"

                strAntwort = InputBox(strFrage + "(DescriptionText)", strTitle, .DescriptionText)

                If strAntwort <> "" Then .DescriptionText = Trim(strAntwort)

                

            Case Else

                ' Fehler

                MsgBox "Unbekannter Kommando-Parameter in der Dokumenten-Variablen.", _

                       vbCritical, _

                       strTitle

                

        End Select

    End With

    

End Sub



Function NummerDerAktuellenTabelleImDokument(strTitel As String)



    ' verwendet den Befehl 'exit for' und exit function

    

    ' wird von EditiereButtonWerteJeNachTabellenZelle verwendet



    Dim aTable     As Table

    Dim aSelTable  As Table

    Dim intI       As Integer

    

    

    If Documents.Count <= 0 Then

        MsgBox "Keine Dokument gefunden." & _

               vbNewLine & _

               "Dieser Makro erwartet ein Dokument mit einer Spezialtabelle.", _

               vbCritical, _

               strTitel

        End

    End If

    

    If ActiveDocument.Tables.Count <= 0 Then

        MsgBox "Keine Tabelle gefunden. Dieser Makro erwartet eine Spezialtabelle.", _

               vbCritical, _

               strTitel

        End

    End If

    

    ' Init

    intI = 1

    Set aSelTable = Selection.Tables(1)

    

    ' Durchsuchen

    For Each aTable In ActiveDocument.Tables

    

        ' Gefunden?

        If aTable.Range = aSelTable.Range Then

            ' Ja

            NummerDerAktuellenTabelleImDokument = intI

            Exit For ' Abbruch der Schleife

        End If

        

        ' erhöhen

        intI = intI + 1

        

    Next aTable



End Function



'  ************************************************************************







Code eingefügt mit Syntaxhighlighter 2.5





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: