title image


Smiley Etwas ausgebuffter






Option Explicit



' Dank an

' http://mypage.bluewin.ch/reprobst/WordFAQ/SelInfo.htm



Sub Hyperlinks1()

    

    Dim aHyperlink      As Hyperlink

    Dim strUeberschrift As String

    Dim docOldDoc       As Document

    Dim docNewDoc       As Document

    Dim strPageNummer   As String

    

    

    Set docOldDoc = ActiveDocument

    docOldDoc.ComputeStatistics wdStatisticPages



    Set docNewDoc = Documents.Add

    

    strUeberschrift = vbNewLine & _

                      vbNewLine

    strUeberschrift = strUeberschrift & _

                      "Hyperlink-Liste" & _

                      vbNewLine

    Selection.TypeText strUeberschrift

    

    For Each aHyperlink In docOldDoc.Hyperlinks

        

        aHyperlink.Range.Copy

        strPageNummer = aHyperlink.Range.Information(wdActiveEndPageNumber)

        

        Selection.TypeText aHyperlink.Range.Text & _

                           ": "

        Selection.EndKey unit:=wdStory

        Selection.Paste

        Selection.TypeText vbTab & _

                           strPageNummer & _

                           vbNewLine

    

    Next aHyperlink

    

    Selection.HomeKey unit:=wdStory

    

    MsgBox "Fertig.", _

           vbInformation, _

           "Hyperlinks erfassen"

    

End Sub







Code eingefügt mit Syntaxhighlighter 2.4





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: