title image


Smiley Re: Auch im Fußnotentext suchen!
Hallo Sandra,



anbei ein Code aus einem größeren Makro mit einem UserForm. Das Makro listet die benutzten und unbenutzen Vorlagen in Listboxen eines Userforms auf. Schau Dir vor allem diese Bereiche an, die wichtig sind, um durch die verschiedenen Bereiche eines Dokumentes zu laufen - geht allerdings auch nicht durch alle Ranges :-(







Private Function boolRanges(Style As String) As Boolean

...

End Function



Private Sub FindStyles()

...

            If Style.InUse = True And boolRanges(Style.NameLocal) = True Then

                    ListBox_UsedPgfStyles.AddItem Style

...

End Sub





Code eingefügt mit Syntaxhighlighter 2.5







Und hier der komplette Code, der aber natürlich nur mit dem entsprechenden Form funktionieren würde:









' * Creates Listboxes for User-defined Pgf and Chr Styles that are currently *

' * in use or unused, counts the (un)used styles and deletes them on request *

Private Sub btnExit_Click()

    End

End Sub

Function BuiltInStylesCount()

    For Each Style In ActiveDocument.Styles

        If Style.BuiltIn = True Then

            BuiltInStylesCount = BuiltInStylesCount + 1

        End If

    Next Style

End Function

Function UserStylesCount()

    

    UserStylesCount = _

    ListBox_UsedPgfStyles.ListCount + ListBox_UnusedPgfStyles.ListCount + _

    ListBox_UsedChrStyles.ListCount + ListBox_UnusedChrStyles.ListCount

    

'    For Each Style In ActiveDocument.Styles

'        If Style.BuiltIn = False Then

'            UserStylesCount = UserStylesCount + 1

'        End If

'    Next Style

End Function

Function AllStylesCount()

    AllStylesCount = ActiveDocument.Styles.Count

End Function

Private Function boolRanges(Style As String) As Boolean

    Dim myRange As Range

    boolRanges = False

    For Each myRange In ActiveDocument.StoryRanges

        With myRange.Find

            .ClearFormatting

            .Text = ""

            .Style = Style

            .Wrap = wdFindContinue

            Do While .Execute(Replace:=wdReplaceNone)

                boolRanges = True

                Exit Function

            Loop

        End With

    Next myRange

End Function

Private Sub FindStyles()



Set myDoc = ActiveDocument.Content

Set myADS = ActiveDocument.Styles



For Each Style In myADS

    myCounter = myCounter + 1

    StatusBar = _

    myCounter & " of " & AllStylesCount & _

    " styles scanned. Analysing use of """ & Style & """"

    If Style.BuiltIn = False Then

        If Style.Type = wdStyleTypeParagraph Then

            If Style.InUse = True And boolRanges(Style.NameLocal) = True Then

                    ListBox_UsedPgfStyles.AddItem Style

                Else

                    ListBox_UnusedPgfStyles.AddItem Style

            End If

        Else

            If Style.InUse = True And boolRanges(Style.NameLocal) = True Then

                    ListBox_UsedChrStyles.AddItem Style

                Else

                    ListBox_UnusedChrStyles.AddItem Style

            End If

        End If

    End If

Next Style

End Sub

Sub UserForm_Initialize()

    Caption = "Total Style Control 1.4"

    FrmPgfs.Caption = "User-defined Paragraph Styles"

    FrmChrs.Caption = "User-defined Character Styles"

    btnDeleteStyles.Caption = "Apply"

    

    UserStylesCount

    FindStyles

    StatusBar = "Style analysis done."



    StatisticLabel.Caption = _

    BuiltInStylesCount & " Built-In Styles and " & _

    UserStylesCount & " User-defined styles " & _

    "(" & AllStylesCount & " total)"



    Label_UsedPgfStyles.Caption = _

    "Total: " & ListBox_UsedPgfStyles.ListCount & " Used Paragraph styles"

    Label_UnusedPgfStyles.Caption = _

    "Total: " & ListBox_UnusedPgfStyles.ListCount & " Unused Paragraph styles"

    Label_UsedChrStyles.Caption = _

    "Total: " & ListBox_UsedChrStyles.ListCount & " Used Character styles"

    Label_UnusedChrStyles.Caption = _

    "Total: " & ListBox_UnusedChrStyles.ListCount & " Unused Character styles"



    If ListBox_UsedPgfStyles.ListCount = 0 Then

        ToggleAllUsedPgfs.Enabled = False

        ToggleAllUsedPgfs.Caption = "No Styles Found."

    End If

    If ListBox_UnusedPgfStyles.ListCount = 0 Then

        ToggleAllUnusedPgfs.Enabled = False

        ToggleAllUnusedPgfs.Caption = "No Styles Found."

    End If

    If ListBox_UsedChrStyles.ListCount = 0 Then

        ToggleAllUsedChrs.Enabled = False

        ToggleAllUsedChrs.Caption = "No Styles Found."

    End If

    If ListBox_UnusedChrStyles.ListCount = 0 Then

        ToggleAllUnusedChrs.Enabled = False

        ToggleAllUnusedChrs.Caption = "No Styles Found."

    End If

        

    TogglePgfAutoUpdate.Caption = "No Styles have ""Automatically Update"" turned on."



    For Each Style In ActiveDocument.Styles

        If Style.Type = wdStyleTypeParagraph Then

            If Style.AutomaticallyUpdate = True Then

                CountAutoPgfs = CountAutoPgfs + 1

                TogglePgfAutoUpdate.Caption = CountAutoPgfs & " Style(s) use ""Automatically Update"". Turn Off?"

                TogglePgfAutoUpdate.Enabled = True

            End If

            If CountAutoPgfs = 0 Then

                TogglePgfAutoUpdate.Enabled = False

                TogglePgfAutoUpdate.Caption = "No Styles have ""Automatically Update"" turned on."

            End If

        End If

    Next Style



End Sub

Private Sub ToggleAllUsedPgfs_Click()

    If ToggleAllUsedPgfs = False Then

        ToggleAllUsedPgfs.Caption = "Select all styles?"

        For i = 0 To ListBox_UsedPgfStyles.ListCount - 1

                ListBox_UsedPgfStyles.Selected(i) = False

        Next i

    Else

        ToggleAllUsedPgfs.Caption = "All styles selected."

        For i = 0 To ListBox_UsedPgfStyles.ListCount - 1

                ListBox_UsedPgfStyles.Selected(i) = True

        Next i

    End If

End Sub

Private Sub ToggleAllUnusedPgfs_Click()

    If ToggleAllUnusedPgfs = False Then

        ToggleAllUnusedPgfs.Caption = "Select all styles?"

        For i = 0 To ListBox_UnusedPgfStyles.ListCount - 1

                ListBox_UnusedPgfStyles.Selected(i) = False

        Next i

    Else

        ToggleAllUnusedPgfs.Caption = "All styles selected."

        For i = 0 To ListBox_UnusedPgfStyles.ListCount - 1

                ListBox_UnusedPgfStyles.Selected(i) = True

        Next i

    End If

End Sub

Private Sub ToggleAllUsedChrs_Click()

    If ToggleAllUsedChrs = False Then

        ToggleAllUsedChrs.Caption = "Select all styles?"

        For i = 0 To ListBox_UsedChrStyles.ListCount - 1

                ListBox_UsedChrStyles.Selected(i) = False

        Next i

    Else

        ToggleAllUsedChrs.Caption = "All styles selected."

        For i = 0 To ListBox_UsedChrStyles.ListCount - 1

                ListBox_UsedChrStyles.Selected(i) = True

        Next i

    End If

End Sub

Private Sub ToggleAllUnusedChrs_Click()

    If ToggleAllUnusedChrs = False Then

        ToggleAllUnusedChrs.Caption = "Select all styles?"

        For i = 0 To ListBox_UnusedChrStyles.ListCount - 1

                ListBox_UnusedChrStyles.Selected(i) = False

        Next i

    Else

        ToggleAllUnusedChrs.Caption = "All styles selected."

        For i = 0 To ListBox_UnusedChrStyles.ListCount - 1

                ListBox_UnusedChrStyles.Selected(i) = True

        Next i

    End If

End Sub

Private Sub TogglePgfAutoUpdate_Click()

    If TogglePgfAutoUpdate = False Then

        For Each Style In ActiveDocument.Styles

        If Style.Type = wdStyleTypeParagraph Then

            If Style.AutomaticallyUpdate = True Then

                CountAutoPgfs = CountAutoPgfs + 1

                TogglePgfAutoUpdate.Caption = CountAutoPgfs & " Style(s) use ""Automatically Update"". Turn Off?"

                TogglePgfAutoUpdate.Enabled = True

            End If

            If CountAutoPgfs = 0 Then

                TogglePgfAutoUpdate.Enabled = False

                TogglePgfAutoUpdate.Caption = "No Styles have ""Automatically Update"" turned on."

            End If

        End If

    Next Style

    Else

        TogglePgfAutoUpdate.Caption = "Turn off ""Automatically Update"" for all styles!"

    End If

End Sub

Private Sub btnDeleteStyles_Click()

    Dim i As Long

    

    If TogglePgfAutoUpdate = True Then

        For Each Style In ActiveDocument.Styles

            If Style.Type = wdStyleTypeParagraph Then

                Style.AutomaticallyUpdate = False

            End If

        Next Style

    TogglePgfAutoUpdate.Caption = "No Styles have ""Automatically Update"" turned on."

    TogglePgfAutoUpdate = False

    TogglePgfAutoUpdate.Enabled = False

    End If



    For i = ListBox_UsedPgfStyles.ListCount - 1 To 0 Step -1

        If ListBox_UsedPgfStyles.Selected(i) Then

                StatusBar = "Deleting used Paragraph styles ... " & _

                ListBox_UsedPgfStyles.ListCount & " styles left. " & _

                "Deleting """ & ActiveDocument.Styles(ListBox_UsedPgfStyles.List(i)) & """ ..."

            ActiveDocument.Styles(ListBox_UsedPgfStyles.List(i)).Delete

            ListBox_UsedPgfStyles.RemoveItem i

        End If

        ActiveDocument.UndoClear

    Next i

    If ListBox_UsedPgfStyles.ListCount = 0 Then

        ToggleAllUsedPgfs = False

        ToggleAllUsedPgfs.Enabled = False

        ToggleAllUsedPgfs.Caption = "No Styles Found."

    End If



    

    For i = ListBox_UnusedPgfStyles.ListCount - 1 To 0 Step -1

        If ListBox_UnusedPgfStyles.Selected(i) Then

                StatusBar = "Deleting unused Paragraph styles ... " & _

                ListBox_UnusedPgfStyles.ListCount & " styles left. " & _

                "Deleting """ & ActiveDocument.Styles(ListBox_UnusedPgfStyles.List(i)) & """ ..."

            ActiveDocument.Styles(ListBox_UnusedPgfStyles.List(i)).Delete

            ListBox_UnusedPgfStyles.RemoveItem i

        End If

        ActiveDocument.UndoClear

    Next i

    If ListBox_UnusedPgfStyles.ListCount = 0 Then

        ToggleAllUnusedPgfs = False

        ToggleAllUnusedPgfs.Enabled = False

        ToggleAllUnusedPgfs.Caption = "No Styles Found."

    End If

    

    For i = ListBox_UsedChrStyles.ListCount - 1 To 0 Step -1

        If ListBox_UsedChrStyles.Selected(i) Then

                StatusBar = "Deleting used Character styles ... " & _

                ListBox_UsedChrStyles.ListCount & " styles left. " & _

                "Deleting """ & ActiveDocument.Styles(ListBox_UsedChrStyles.List(i)) & """ ..."

            ActiveDocument.Styles(ListBox_UsedChrStyles.List(i)).Delete

            ListBox_UsedChrStyles.RemoveItem i

        End If

        ActiveDocument.UndoClear

    Next i

    If ListBox_UsedChrStyles.ListCount = 0 Then

        ToggleAllUsedChrs = False

        ToggleAllUsedChrs.Enabled = False

        ToggleAllUsedChrs.Caption = "No Styles Found."

    End If

    

    For i = ListBox_UnusedChrStyles.ListCount - 1 To 0 Step -1

        If ListBox_UnusedChrStyles.Selected(i) Then

                StatusBar = "Deleting unused Character styles ... " & _

                ListBox_UnusedChrStyles.ListCount & " styles left. " & _

                "Deleting """ & ActiveDocument.Styles(ListBox_UnusedChrStyles.List(i)) & """ ..."

            ActiveDocument.Styles(ListBox_UnusedChrStyles.List(i)).Delete

            ListBox_UnusedChrStyles.RemoveItem i

        End If

        ActiveDocument.UndoClear

    Next i

    If ListBox_UnusedChrStyles.ListCount = 0 Then

        ToggleAllUnusedChrs = False

        ToggleAllUnusedChrs.Enabled = False

        ToggleAllUnusedChrs.Caption = "No Styles Found."

    End If



    StatisticLabel.Caption = _

    AllStylesCount - UserStylesCount & " Built-In Styles and " & _

    UserStylesCount & " User-defined styles " & _

    "(" & AllStylesCount & " total)"



    Label_UsedPgfStyles.Caption = _

    "Total: " & ListBox_UsedPgfStyles.ListCount & " Used Pgf Styles"

    Label_UnusedPgfStyles.Caption = _

    "Total: " & ListBox_UnusedPgfStyles.ListCount & " Used Pgf Styles"

    Label_UsedChrStyles.Caption = _

    "Total: " & ListBox_UsedChrStyles.ListCount & " Used Chr Styles"

    Label_UnusedChrStyles.Caption = _

    "Total: " & ListBox_UnusedChrStyles.ListCount & " Unused Chr Styles"



    StatusBar = ""



'End

End Sub





Code eingefügt mit Syntaxhighlighter 2.5






-------------------------------------------
"Nobody will ever need more than 640k RAM!"
1981 Bill Gates




geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: