Microsoft Excel

Herbers Excel/VBA-Archiv

Fußnoten mit vba in word auslesen

Betrifft: Fußnoten mit vba in word auslesen von: Felix
Geschrieben am: 18.10.2014 19:06:22

Hallo Leute,

ich habe ein Problem mit dem Zugriff auf Fußnoten in Word-Dokumenten via VBA. In diesen soll nämlich gesucht und dann ein Wort markiert werden, damit ich anschließend wiederum die Seitenzahl auslesen kann. Ich bekomme das ganze aber nicht hingebastelt und habe in anderen Foren bisher nur Beispiele mit "range" jedoch nicht mit "selection" gefunden. Ich hoffe ihr könnt mir weiterhelfen!

Sub Zahlen_hinzufügen()
             
Dim intRowCnt As Integer
Dim AppWD As Word.Application
Dim fn
Dim wdDoc As Word.Document
Dim spalte As Integer
Dim oStory As Range

'''''''''''''''''''''Öfnnen der Word -Datei''''''''''''''''''''
Const StartDrive = "C:"
Const StartDir = "\DasBuch"
ChDrive StartDrive
ChDir StartDir
fn = Application.GetOpenFilename("Word-Dokumente, *.docx", , "Bitte Datei auswählen")
If fn = False Then Exit 
Sub 'Abbrechen gedrückt

Set AppWD = CreateObject("Word.Application") 'Word als Object starten

Set wdDoc = AppWD.Documents.Open( _
        Filename:=fn, _
        ConfirmConversions:=False, _
        ReadOnly:=False, _
        AddToRecentFiles:=False, _
        PasswordDocument:="", _
        PasswordTemplate:="", _
        Revert:=False, _
        WritePasswordDocument:="", _
        WritePasswordTemplate:="", _
        Format:=wdOpenFormatAuto, _
        Visible:=True)
 

 
 
 '''''''''''''''''''Name aus Excel-Zelle auslesen '''''''''''''''
 
intCol = 2 'Nummer der Spalte in Excel, die ausgelesen werden soll

For intRowCnt = 2 To Cells(Rows.Count, intCol).End(xlUp).Row ' Für jeden Namen in Exceltabelle
    PersonName = Cells(intRowCnt, intCol)
    spalte = 4 'Spalte ab der Zahlen hineingeschrieben werden sollen

 ''''' An den Anfang des Dokumentes gehen''''''
    AppWD.Selection.HomeKey wdStory

'''''''''''''''''''Suche im aktiven Word-Dokument(Main) nach PersonName '''''''''''''''

weitersuchen:
    With AppWD.Selection.Find
        .ClearFormatting
        .Forward = True
        .MatchCase = True
        .Execute FindText:=PersonName
    End With


    
    If AppWD.Selection.Find.Found = False Then GoTo naechstesuche

 '''''''''''''''''''Lese die Seitenzahl aus, auf der das Suchergebnis gefunden wurde und  _
schreibe sie in Excel '''''''''''''''
frei:
    If Not Cells(intRowCnt, spalte) = "" Then ' wenn schon zahl in spalte dann nächste Spalte
        spalte = spalte + 1
        GoTo frei
    End If

    If AppWD.Selection.Information(wdActiveEndAdjustedPageNumber) = Cells(intRowCnt, spalte - 1) _
 Then GoTo weitersuchen ' Falls gleiche Seitenzahl wie davor dann überspringen
    Cells(intRowCnt, spalte) = AppWD.Selection.Information(wdActiveEndAdjustedPageNumber)
    GoTo weitersuchen


'''''''''''''''''''Suche im aktiven Word-Dokument(Fußnoten) nach PersonName '''''''''''''''
naechstesuche:
weitersuchen2:
 Set oStory = wdDoc.StoryRanges(wdFootnotesStory)
    With oStory.Selection.Find
        .ClearFormatting
        .Forward = True
        .MatchCase = True
        .Execute FindText:=PersonName
    End With

    If AppWD.Selection.Find.Found = False Then GoTo naechsteperson

 '''''''''''''''''''Lese die Seitenzahl aus, auf der das Suchergebnis gefunden wurde und  _
schreibe sie in Excel '''''''''''''''
frei2:
    If Not Cells(intRowCnt, spalte) = "" Then ' wenn schon zahl in spalte dann nächste Spalte
        spalte = spalte + 1
        GoTo frei2
    End If

    If AppWD.Selection.Information(wdActiveEndAdjustedPageNumber) = Cells(intRowCnt, spalte - 1) _
 Then GoTo weitersuchen2 ' Falls gleiche Seitenzahl wie davor dann überspringen
    Cells(intRowCnt, spalte) = AppWD.Selection.Information(wdActiveEndAdjustedPageNumber)
    GoTo weitersuchen2

naechsteperson:

Next

AppWD.Documents(fn).Close SaveChanges:=False
AppWD.Quit
Set AppWD = Nothing

End Sub

Vielen Dank im Voraus,

Felix

  

Betrifft: AW: Fußnoten mit vba in word auslesen von: Felix
Geschrieben am: 19.10.2014 09:38:56

Niemand eine Idee?


  

Betrifft: AW: Fußnoten mit vba in word auslesen von: fcs
Geschrieben am: 19.10.2014 12:17:46

Hallo Felix,

wenn möglich, dann sollte man auch in Word ohne Selektionen arbeiten.

Ich hab dein Makro mal in die Richtung angepasst.
Ich hab die eigentliche Suche in eine separate Sub ausgegliedert, da die Suche im Haupttext und den Fußnoten nach dem gleichen Schema funktioniert. Zusätzlich hab ich die verschachtelten Sprünge nach Prüfungen durch entsprechende Do-Loop-Schleifen ersetzt, da dies übersichtlicher ist.

Gruß
Franz

Sub Zahlen_hinzufügen_neu()
             
    Dim intRowCnt As Long
    Dim AppWD As Word.Application
    Dim fn
    Dim wdDoc As Word.Document
    Dim Spalte As Long
    
    Dim intCol As Integer, PersonName As String
    
    '### Öfnen der Word -Datei ###
    Const StartDrive = "C:"
    Const StartDir = "\DasBuch"
    'Const StartDir = "C:\Users\Public\Test"
    ChDrive StartDrive
    ChDir StartDir
    fn = Application.GetOpenFilename("Word-Dokumente, *.docx", , "Bitte Datei auswählen")
    If fn = False Then Exit Sub 'Abbrechen gedrückt
    
    Set AppWD = CreateObject("Word.Application") 'Word als Object starten
    
    'ausgewählte Datei schreibgeschützt öffnen
    Set wdDoc = AppWD.Documents.Open( _
            Filename:=fn, _
            ConfirmConversions:=False, _
            ReadOnly:=True, _
            AddToRecentFiles:=False, _
            PasswordDocument:="", _
            PasswordTemplate:="", _
            Revert:=False, _
            WritePasswordDocument:="", _
            WritePasswordTemplate:="", _
            Format:=wdOpenFormatAuto, _
            Visible:=True)
     
    'AppWD.Visible = True   ' während der Testphase
      
     '### Name aus Excel-Zelle auslesen ###
     
    intCol = 2 'Nummer der Spalte in Excel, die ausgelesen werden soll
    
    For intRowCnt = 2 To Cells(Rows.Count, intCol).End(xlUp).Row ' Für jeden Namen in  _
Exceltabelle
        PersonName = Cells(intRowCnt, intCol)
        Spalte = 4 'Spalte ab der Zahlen hineingeschrieben werden sollen
    
    '### Suche im aktiven Word-Dokument(Main) nach PersonName ###
        Call prcSuche(oSuchrange:=wdDoc.StoryRanges(wdMainTextStory), strSuch:=PersonName, _
                Zeile:=intRowCnt, Spalte:=Spalte)
    
    '### Suche im aktiven Word-Dokument(Fußnoten) nach PersonName ###
        Call prcSuche(oSuchrange:=wdDoc.StoryRanges(wdFootnotesStory), strSuch:=PersonName, _
                Zeile:=intRowCnt, Spalte:=Spalte)
    
    Next intRowCnt
    
    wdDoc.Close SaveChanges:=False
    AppWD.Quit
    Set AppWD = Nothing

End Sub

Private Sub prcSuche(oSuchrange As Word.Range, strSuch As String, _
        ByVal Zeile As Long, ByRef Spalte As Long)
    Dim intSeite As Integer
   'Suche in MS-Word  und Seiten-Information in Excel eintragen
    Do
        'Suchtext im Word-Range suchen
        With oSuchrange.Find
            .ClearFormatting
            .Forward = True
            .MatchCase = True
            .Execute FindText:=strSuch
        End With
        'Suche abbrechen, wenn Suchbegriff nicht mehr gefunden wird
        If oSuchrange.Find.Found = False Then Exit Do
        
        'Spalte mit leerer Zelle in Zeile suchen
        Do Until Cells(Zeile, Spalte) = "" ' wenn schon zahl in spalte dann nächste Spalte
            Spalte = Spalte + 1
        Loop

        'Lese die Seitenzahl aus, auf der das Suchergebnis gefunden wurde und _
            schreibe sie in Excel
        intSeite = oSuchrange.Information(wdActiveEndAdjustedPageNumber)
        If intSeite <> Cells(Zeile, Spalte - 1) Then
            Cells(Zeile, Spalte) = intSeite
        End If
    Loop
End Sub



  

Betrifft: AW: Fußnoten mit vba in word auslesen von: Felix
Geschrieben am: 19.10.2014 12:44:05

Lieber Franz,

funktioniert super!

Vielen vielen Dank für die große Hilfe ! :-)

Felix


 

Beiträge aus den Excel-Beispielen zum Thema "Fußnoten mit vba in word auslesen"