Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1384to1388
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Fußnoten mit vba in word auslesen

Fußnoten mit vba in word auslesen
18.10.2014 19:06:22
Felix
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fußnoten mit vba in word auslesen
19.10.2014 09:38:56
Felix
Niemand eine Idee?

AW: Fußnoten mit vba in word auslesen
19.10.2014 12:17:46
fcs
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

Anzeige
AW: Fußnoten mit vba in word auslesen
19.10.2014 12:44:05
Felix
Lieber Franz,
funktioniert super!
Vielen vielen Dank für die große Hilfe ! :-)
Felix

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige