title image


Smiley VBA: Pseudo-Hyperlinkfunktion für Indexverzeichnis


Hallo!



Ein Index soll bei ***ausgedruckten*** Texten das Finden von Stichwörtern jenseits vom Inhaltsverzeichnis ermöglichen. Leider hat Microsoft verschlafen, die Möglichkeit die Stelle anzuspringen einzubauen.



Hiermit geht's:









Option Explicit



' Springe aus Index zu einer Seite



Sub SpringeAusIndexZuEinerSeite()



    ' Springe aus Index zu einer Seite



    Const strTitel = "Springe aus Index zu einer Seite"



    Dim strSeitenzahl       As String

    Dim strErstesWort       As String

    Dim rngPara             As Range

    Dim intI                As Integer

    Dim boolFound           As Boolean





    If Documents.Count = 0 Then End



    strErstesWort = Trim(Selection.Paragraphs(1).Range.Words(1).Text)



    boolFound = False



    ' Markierung über mehrere Zeichen?

    If Selection.Start <> Selection.End Then

        ' Ja, Markierung über mehrere Zeichen

        strSeitenzahl = Selection.Text

        If funcZahlIstSeitenzahl(strSeitenzahl) Then

            ' Flag setzen

            boolFound = True

        Else

            ' Fehler, daher Auswahl kollabieren

            Selection.Collapse wdCollapseStart

        End If

    End If



    If Not boolFound Then

        ' Markierung nicht über mehrere Zeichen;

        ' nur Einfügemarke vorhanden

        strSeitenzahl = Selection.Words(1)



        Set rngPara = Selection.Paragraphs(1).Range



        intI = 0



        ' so lange die gesuchte Seitenzahl noch nicht

        ' numerisch ist

        While (Not IsNumeric(Selection.Text)) And _

              (rngPara = Selection.Paragraphs(1).Range) And _

              (intI < 4)



            If Len(rngPara) > 1 Then



                ' Wenn die Markierung nach (!) einer Zahl

                ' steht, so wird diese nicht erfasst

                ' (sondern "," bzw. vbCr); nun wird nach links

                ' eine Zahl gesucht

                While (Not IsNumeric(Selection.Text)) And _

                      (rngPara = Selection.Paragraphs(1).Range)



                    ' nach links gehen

                    Selection.MoveLeft wdCharacter, 1, wdMove



                Wend



            End If



            ' falls in den nächsten Absatz gegangen wurde

            If (rngPara <> Selection.Paragraphs(1).Range) Then

                ' gehe zurück

                Selection.MoveRight wdCharacter, 1, wdMove

            End If



            ' versuche erneut, die Seitenzahl zu erheben

            strSeitenzahl = Selection.Words(1)



            ' Falls die Markierung vorne im Absatz ist,

            ' wird diese nach hinten ans Ende des Absatzes

            ' verschoben

            If Not IsNumeric(strSeitenzahl) Then

                If Selection.Paragraphs(1).Range.Words.Count >= 3 Then

                    Selection.Paragraphs(1).Range.Words(3).Select

                    Selection.Collapse wdCollapseStart

                End If

            End If



            intI = intI + 1



        Wend



    End If



    SucheAufSeite strErstesWort, strSeitenzahl, strTitel



End Sub



' Gehe zu Index



Sub GeheZuIndex()



    ' Gehe zu Index



    ' ggf. Abbruch: Kein Dokument offen

    If Documents.Count <= 0 Then End



    ' ggf. Abbruch: Kein Index vorhanden

    If ActiveDocument.Indexes.Count <= 0 Then

        ' Meldung

        MsgBox "Keinen Index gefunden.", _

               vbInformation, _

               "Gehe zu Index"

        ' Abbruch

        End

    End If



    ' Springen

    ActiveDocument.Indexes(1).Range.Words(2).Select

    Selection.Collapse wdCollapseStart



    ' etwas scrollen

    If ActiveDocument.Indexes(1).Range.Words.Count >= 7 Then

        ActiveDocument.Windows(1).ScrollIntoView _

              ActiveDocument.Indexes(1).Range.Words(7), True

    Else

        ActiveDocument.Windows(1).ScrollIntoView _

              ActiveDocument.Indexes(1).Range.Words.Last, True

    End If



End Sub



' **********



Private Sub SucheAufSeite(strWort As String, _

                          strSeitenzahl As String, _

                          strTitel As String)



    If funcZahlIstSeitenzahl(strSeitenzahl) Then



        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=Val(strSeitenzahl)



        ActiveDocument.Bookmarks("\Page").Range.Find.ClearFormatting



        With ActiveDocument.Bookmarks("\Page").Range.Find

            .Forward = True

            .Wrap = wdFindAsk

            .Format = False

            .ClearFormatting

            .MatchCase = False

            .MatchWholeWord = False

            .Replacement.ClearFormatting

            .Replacement.Text = ""

            .Text = strWort

            .Execute

            If .Found Then

                .Parent.Select

            Else

                MsgBox "Nicht gefunden " & _

                       strWort & _

                       " auf Seite " & _

                       strSeitenzahl, _

                       vbInformation, _

                       strTitel

            End If

        End With



    Else



        MsgBox "Keine (gültige) Seitenzahl gefunden.", _

               vbInformation, _

               strTitel



    End If



End Sub



Sub TestOn_funcZahlIstSeitenzahl()



    MsgBox funcZahlIstSeitenzahl("3")

    MsgBox funcZahlIstSeitenzahl("333")

    MsgBox funcZahlIstSeitenzahl("a3")

    MsgBox funcZahlIstSeitenzahl("1,3")

    MsgBox funcZahlIstSeitenzahl("-3")

    MsgBox funcZahlIstSeitenzahl("1.3")



End Sub



Function funcZahlIstSeitenzahl(strZahl As String) _

                                  As Boolean



    ' Prüft, ob ein String eine gültige Seitenzahl im aktuellen

    ' Dokument ist.



    Dim Number   ' integer oder double o.ä.





    ' Ist es eine Zahl?

    If Not IsNumeric(strZahl) Then

        funcZahlIstSeitenzahl = False

        ' Abbruch

        Exit Function

    End If



    ' Zeichen wie , und . und - enthalten?

    If InStr(1, strZahl, ".") > 0 Or _

       InStr(1, strZahl, ",") > 0 Or _

       InStr(1, strZahl, "-") > 0 Then

        funcZahlIstSeitenzahl = False

        ' Abbruch

        Exit Function

    End If



    ' Umwandeln

    Number = Val(strZahl)



    ' ganzzahlig?

    If Number <> Fix(Number) Then

        funcZahlIstSeitenzahl = False

        ' Abbruch

        Exit Function

    End If



    ' plausibel?

    If Number <= 0 Or _

       Number > Selection.Information(wdNumberOfPagesInDocument) Then

        funcZahlIstSeitenzahl = False

        ' Abbruch

        Exit Function

    End If



    ' Gültig:

    funcZahlIstSeitenzahl = True



End Function







Code eingefügt mit Syntaxhighlighter 4.0





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: