title image


Smiley VBA: Alle Module auflisten


VBA: Alle Module aller geöffneten Dokumentenvorlagen auflisten



Guten Rutsch!











Option Explicit



' Word 2000

' Win XP / Win 2000



' Version Nr.1 vom 28.12.2003



' Word braucht im VBA-Editor

' im Menü Extras | Verweise

' einen Verweis auf

' "Microsoft Visual Basic for Applications Extensibility 5.3"



Public Sub AlleModuleAuflisten()

    

    ' Listet alle Module aller Dokumentenvorlagen aller offenen Dokumente

    ' plus normal.dot.

    ' Funktioniert auch bei keinem offenen Dokument

    ' (normal.dot auflisten).

    

    ' Es gibt eine Mini LookUp-Tabelle (ein string), die dazu dient, dass

    ' jede Dokumentenvorlage nur einmal gelistet wird.

    '

    ' Die Verwendung von # in der Mini LookUp-Tabelle sichert, dass

    ' bei der Prüfung genau das ganze Wort (Name des Templates)

    ' geprüft wird (Ohne # würde z.B. für "info"

    ' TextinfossammelnSymbolleistenanzeigen

    ' [statt #Textinfossammeln#Symbolleistenanzeigen#]

    ' fälschlich als enthält erkannt

    ' (obwohl info zu kurz ist); oder "dottest" würde bei testdottestfuerRange

    ' [statt #testdot#testfuerRange#]

    ' fälschlich als enthält erkannt (Ende bzw. Anfang zweier Namen

    ' werden fälschlich als zusammengehörig gesehen)).

    ' Daher das # bei instr etc.

    

    ' Titel:

    Const strConstTitel = _

             "Auflisten aller Module der Formatvorlagen aller geöffneten Dokumente"



    Dim docMyDoc              As Document   ' Alle Dokus durchgehen

    Dim templateMyNormalDot   As Template   ' erstes Template: normal.dot

    Dim strAlleTemplates      As String     ' Mini LookUp-Tabelle

    Dim intI                  As Integer    ' Zähler

    Dim strMeldung            As String     ' für die Ausgabe

    Dim intCountModule        As Integer    ' Zähler

    

    

    Documents.Add

    

    Selection.TypeText "Alle Module auflisten" & _

                       " am " & Date & " um " & Time() & "." & vbNewLine & _

                       vbNewLine _

                       

                       

    Set templateMyNormalDot = Application.Templates.Item("Normal.dot")

    Selection.TypeText templateMyNormalDot.Name & _

                       vbNewLine & _

                       "--------------------------" & _

                       vbNewLine

    ModuleAuflisten templateMyNormalDot, _

                    intCountModule

                      

    ' Mini LookUp-Tabelle: Zum # s.o.

    strAlleTemplates = strAlleTemplates & _

                       "#" & templateMyNormalDot & "#"

    

    ' Schleife Documents

    For Each docMyDoc In Application.Documents

        

        ' Zum # s.o.

        If InStr(1, strAlleTemplates, "#" & docMyDoc.AttachedTemplate.Name & "#") = 0 Then

            Selection.TypeText docMyDoc.AttachedTemplate.Name & _

                               vbNewLine & _

                               "--------------------------" & _

                               vbNewLine

            ModuleAuflisten docMyDoc.AttachedTemplate, _

                            intCountModule

                              

            ' Zum # s.o.

            strAlleTemplates = strAlleTemplates & "#" & _

                               docMyDoc.AttachedTemplate.Name & _

                               "#"

            ' Zähler erhöhen

            intI = intI + 1

        End If

    

    Next docMyDoc



    ' Meldung

    ' (intI + 1 wegen Normal.dot außerhalb der Schleife

    strMeldung = "Fertig." & _

           vbNewLine & _

           vbNewLine & _

           "Templates waren: " & _

           strAlleTemplates & "." & _

           vbNewLine & "Gezählt: " & _

           intI + 1 & _

           " Vorlage(n) (mit normal.dot)." & _

           vbNewLine & _

           "Anzahl der Dokumente: " & _

           Application.Documents.Count & _

           "." & _

           vbNewLine & _

           "Anzahl der Module: " & _

           intCountModule & _

           "." & _

           vbNewLine & vbNewLine & _

           "Bitte nun ggf. pro Abschnitt einzeln " & _

           "sortieren (Menü Tabelle)."

               

    Selection.HomeKey unit:=wdStory

    Application.ScreenRefresh

    Application.ScreenUpdating = True

               

    MsgBox strMeldung, _

           vbInformation, _

           strConstTitel

    

End Sub



Private Sub ModuleAuflisten(templateMyTemplate As Template, _

                            intCountModule As Integer)



    ' Auflisten



    Dim vbcMeinVBComponent  As VBComponent

    

    

    ' Schleife

    For Each vbcMeinVBComponent In templateMyTemplate.VBProject.VBComponents

        

        Selection.TypeText vbcMeinVBComponent.CodeModule & _

                           SetzeTyp(vbcMeinVBComponent) & _

                           vbNewLine

                                  

    Next vbcMeinVBComponent

    

    Selection.TypeText vbNewLine & vbNewLine

            

    intCountModule = intCountModule + _

                     templateMyTemplate.VBProject.VBComponents.Count

    

End Sub



Private Function SetzeTyp(oKomponente As VBComponent) As String

    

    ' Modultyp erstellen

    

    Select Case oKomponente.Type

        Case vbext_ct_ClassModule

            SetzeTyp = "cls"

        Case vbext_ct_MSForm

            SetzeTyp = "frm"

        Case Else

            SetzeTyp = "bas"

    End Select

    

    SetzeTyp = " (" & SetzeTyp & ")"

    

End Function



Code eingefügt mit Syntaxhighlighter 2.5





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: