18.03.2016

5164

Word Seitenzahlen für Suchstring ermitteln

Hallo,

Mittels vba möchte ich ein ganzes Word-Dokument nach einem bestimmten String durchsuchen und alle Seitenzahlen wo dieser String auftaucht in eine Variable (Array) schreiben.
Diese Variable nutze ich dann für die weitere Verarbeitung.

With ActiveDocument.Content.Find
    .Text = "MeinSuchString"  
    
    Do While .Execute
        [Seitenzahl in Array]
    Loop
    
End With

Wie bekomme ich an dieser Stelle die Seitenzahl?

Torsten

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 299460

Url: https://administrator.de/forum/word-seitenzahlen-fuer-suchstring-ermitteln-299460.html

Ausgedruckt am: 31.12.2024 um 17:12 Uhr

22 Kommentare

Neuester Kommentar

Mit einer Collection so

Dim col As New Collection
Selection.GoTo wdGoToPage, wdGoToFirst
ActiveDocument.Content.Select
With Selection.Find
    .ClearFormatting
    .Text = "MeinSuchString"  
    .Forward = True
    Do While .Execute
        col.Add Selection.Information(wdActiveEndPageNumber)
    Loop
End With
for each item in col
   msgbox "Gefunden auf Seite : " & item  
Next

oder auch mit Plain-Array so:

Dim arr(), cnt As Long
cnt = 1
Selection.GoTo wdGoToPage, wdGoToFirst
ActiveDocument.Content.Select
With Selection.Find
    .ClearFormatting
    .Text = "MeinSuchString"  
    .Forward = True
    Do While .Execute
        ReDim Preserve arr(1 To cnt)
        arr(cnt) = Selection.Information(wdActiveEndPageNumber)
        cnt = cnt + 1
    Loop
End With
For i = 1 To UBound(arr)
    MsgBox "Gefunden auf Seite: " & arr(i)  
Next

Gruß jodel32

Hallo jodel32,
funktioniert Beides bestens, vielen Dank.

Zur Info...
Ich benötige es um aus einem Word-Dokument mehrere enthaltene Dokumente, welche jeweils eine unterschiedliche Anzahl an Seiten haben können, einzeln als pdf-Datei zu speichern. Dieser Suchstring steht dabei immer auf der ersten Seite eines Dokuments, so dass ich immer diese erste Seite identifizieren kann.
Hier der komplette Code dazu:

Sub MyArray()

Dim arr(), cnt As Long
cnt = 1

Selection.GoTo wdGoToPage, wdGoToFirst
ActiveDocument.Content.Select

With Selection.Find
    .ClearFormatting
    .Text = "Mein Suchstring mit der Nr."  
    .Forward = True
    Do While .Execute
        ReDim Preserve arr(1 To cnt)
        arr(cnt) = Selection.Information(wdActiveEndPageNumber)
        cnt = cnt + 1
    Loop
End With

For i = 1 To UBound(arr)
    DokumentStart = arr(i)

    If Not i = UBound(arr) Then
        DokumentEnde = arr(i + 1) - 1
    Else
        DokumentEnde = ActiveDocument.ComputeStatistics(wdStatisticPages)
    End If

' Ausgabe  
ActiveDocument.ExportAsFixedFormat OutputFileName:="C:\Dokument_Nr_" & i & ".pdf", ExportFormat:=wdExportFormatPDF, Range:=wdExportFromTo, From:=DokumentStart, To:=DokumentEnde, OpenAfterExport:=False  

Next

End Sub

Was mir noch einfällt, ist aber nur so ein Gedanke, wie könnte ich beim Auffinden des Suchstrings eigentlich eine feste Anzahl der nachfolgenden Zeichen (in dem Fall steht die Dokumentennummer immer hinter dem Suchstring) in ein zweites Array schreiben? Dann hätte ich gleich diese Information für den Dateinamen zur Verfügung...

Gruß
Torsten

Zitat von @goodbytes:
Was mir noch einfällt, ist aber nur so ein Gedanke, wie könnte ich beim Auffinden des Suchstrings eigentlich eine feste Anzahl der nachfolgenden Zeichen (in dem Fall steht die Dokumentennummer immer hinter dem Suchstring) in ein zweites Array schreiben?

Geht einfach, deklariere am Anfang ein zweites Array

dim arr2()

Dann in der Suchschleife das Array entsprechend erweitern

ReDim Preserve arr2(1 To cnt)

Für das Hinzufügen einer festen länge an Zeichen hinter dem Suchstring machst du so (Beispiel für 4 Zeichen):

arr2(cnt) = Range(Selection.End, Selection.End + 4).Text

Gruß jodel32

Hallo jodel32,
seltsam, vba meint zu Range "Sub oder Function nicht definiert".

Gruß
Torsten

Dann steht dein Code in einem Modul und nicht im ActiveDocument Abschnitt, dann musst du stattdessen vorne noch das Dokument mit angeben...ActiveDocument.Content.Range(.......)

Geht ansonsten einwandfrei, hier getestet.

Stimmt, dann geht es natürlich sofort...

Danke !!!

Na prima, ein neues Problem tat sich auf... Nie bleibt es dabei wie es ist... Grrrr...

Nun steckt der String künftig ausschließlich in der Kopfzeile. Also müsste das Makro alle Kopfzeilen durchlaufen um die Arrays zu befüllen.
Wie kann ich das realisieren?

Muss ich dafür eine extra Schleife drumherum machen oder geht es auch eleganter?

    For Each sec In ActiveDocument.Sections 
        sec.Headers(wdHeaderFooterFirstPage).Range 
         ...
    Next 

Gruß goodbytes

Muss ich dafür eine extra Schleife drumherum machen

Jupp, wenn er nur noch in den Headern steckt ja.

Wenn du komplett alles durchsuchen willst kannst du auch die StoryRanges Auflistung hernehmen:

dim rng as Range
for each rng in ActiveDocument.StoryRanges
    '...  
Next

Also irgendwie komm ich mit den StoryRanges nicht klar.
Dieser Code erzeugt mir eine Endlosschleife...

For Each story In ActiveDocument.StoryRanges
 If story.StoryType = wdHeaderFooterPrimary Then
    story.Find.Execute FindText:="Mein Suchstring"      
    While story.Find.Found
       MsgBox story.Find.Text
    Wend
 End If
Next story

Wie nutze ich die StoryRanges in meinem Code richtig?

nicht im Objekt der Story suchen sondern wie ich es oben gemacht habe den Range der Story selektieren und dann mit dem Selection-Objekt arbeiten.

Ach, hab jetzt hin und her versucht, bekomm es nicht hin mit den StoryRanges.
Im Prinzip muss ich jetzt nur noch in den Kopfzeilen suchen, daher versuchte ich es mit:

 For Each sec In ActiveDocument.Sections 
        sec.Headers(wdHeaderFooterFirstPage).Select
       With Selection.Find
               .ClearFormatting
               .Text = "Prüfbericht zum Auftrag Nr."  
               .Forward = True
               Do While .Execute
                    ReDim Preserve arrPages(1 To cnt)
                   ReDim Preserve arrString(1 To cnt)
                   arrPages(cnt) = Selection.Information(wdActiveEndPageNumber)
                   arrString(cnt) = ActiveDocument.Range(Selection.End + 1, Selection.End + 15).Text
                   cnt = cnt + 1
               Loop
        End With
  Next 

Aber das klappt nicht.

Der Fehler steckt sicher in der zweiten Zeile, oder?

Es gibt auch noch wdHeaderFooterPrimary für die Kopfzeilen, deine verwendete Kopfzeile existiert nur wenn die erste Seite eine andere Kopfzeile hat wie die folgenden, Seiten der Section, deswegen musst du beide durchsuchen wenn du jeweils beide verwendest.

sec.Headers(wdHeaderFooterPrimary).Range.Select

Ok, mir reicht da schon "wdHeaderFooterFirstPage", da ich damit immer die erste Kopfzeile eines Unter-Dokumentes bekomme. Wenn der nächste Treffer kommt einfach Seitenzahl minus 1 und ich hab alle Seitenzahlen des Unter-Dokumentes.
Allerdings bekomme ich beim Finden des Strings nicht die aktuelle Seitenzahl des gesamten Dokumentes, sondern nur innerhalb der Section.
Wie komme ich da an die aktuelle Seitenzahl des Gesamt-Dokumentes?

Sorry, dafür habe ich im Moment keine Lösung. Die Info gibt, wenn sich die Selection innerhalb des Headers befindet dort immer die erste Seite der jeweiligen Section aus, egal auf welcher Seite der Section das Suchwort gefunden wurde. Ich habe es auch mit Goto-Sprüngen in die Main-Story der Seite versucht, leider ergebnislos.

Du könntest alternativ ein nicht unsichtbares Seitenzahlenfeld in den Header einbauen, das könnte man dann auslesen und verwenden.

Mmm, schade. Mal schauen wie ich es dann mache.
Danke auf jeden Fall für die viele Hilfe, es war auf jeden Fall sehr lehrreich für mich!

Schönes Wochenende!
Torsten

Hallo jodel32,
im Prinzip habe ich ja in den Kopfzeilen der Unter-Dokumente ebenfalls eine Seitenangabe. In der selben Zeile mit dem Suchstring steht am Ende immer z.B. Seite 1 von 3, je nach Seitenanzahl. Kann man meinen Code so umbasteln, dass er einfach immer beim Finden von Seite 1 von alle Seiten des aktuellen Unterdokument als pdf ausgibt (wie in meinem Post vom 21.03.)?

' Ausgabe  
ActiveDocument.ExportAsFixedFormat OutputFileName:="C:\Dokument_Nr_" & i & ".pdf", ExportFormat:=wdExportFormatPDF, Range:=wdExportFromTo, From:=DokumentStart, To:=DokumentEnde, OpenAfterExport:=False  

In dem Fall brauche ich natürlich die Arrays nicht, da nach der pdf-Erstellung zum nächsten Unter-Dokument mit Seite 1 von übergegangen wird.
Wäre das vielleicht irgendwie möglich?

Gruß goodbytes

Mir ist aufgefallen, dass Word die einzelnen Dokumente ja als "Abschnitt 1", "Abschnitt 2", usw. bezeichnet.
Zum Drucken beispielsweise kann ich also Pages="S3" angeben, was dem 2. Unter-Dokument entspricht.
Allerdings ist das nicht beim Export als PDF möglich. Kann ich vielleicht für jeden Abschnitt die Seitenzahlen von-bis ermitteln? Dann käme ich auch dahin...

So, mit diesem Ansatz geht es:

Dim i As Long, arrPages(), arrString()
    
For i = 1 To ActiveDocument.Sections.Count - 1
      MsgBox "Seiten: " & ActiveDocument.Sections(i).Range.Information(wdActiveEndPageNumber) + 1 & "-" & _  
      ActiveDocument.Sections(i + 1).Range.Information(wdActiveEndPageNumber)
Next i

Naja das listet ja nur alle Sections hintereinander auf. Aber wenn dir das reicht...

Den aktuellen Section-Bereich für die aktuelle Selection bekommst du so

Sub ShowSelectionSectionRange()
    With ActiveDocument
        start_section_index = Selection.Sections(1).Index
        If start_section_index > 1 Then
            sel_page_start = CInt(.Sections(start_section_index - 1).Range.Information(wdActiveEndPageNumber)) + 1
            sel_page_end = .Sections(start_section_index).Range.Information(wdActiveEndPageNumber)
        Else
            sel_page_start = 1
            sel_page_end = Selection.Sections(1).Range.Information(wdActiveEndPageNumber)
        End If
        msgbox "Selektion befindet sich in Section " & start_section_index & " mit den Seiten: " & sel_page_start & "-" & sel_page_end  
    End With
End Sub

Hallo jodel32,
vielleicht kannst du mir nochmal helfen, irgendwie hab ich mich verhaspelt.
Die Seitenzahlen bekomme ich auch so. Nun möchte ich in der Kopfzeile jeder Section, in der ich mich gerade befinde, nach dem Suchstring suchen und die folgenden Zeichen (wie oben schon) in der Variable speichern. Ich hab die Suche jetzt in eine Function gepackt, glaub so ist es übersichtlicher.

Sub EinzelDocs()
    
For i = 1 To ActiveDocument.Sections.Count - 1
ActiveDocument.Sections(i).Range.Select
    With ActiveDocument
        start_section_index = Selection.Sections(1).Index
        If start_section_index > 1 Then
            sel_page_start = CInt(.Sections(start_section_index - 1).Range.Information(wdActiveEndPageNumber)) + 1
            sel_page_end = .Sections(start_section_index).Range.Information(wdActiveEndPageNumber)
        Else
            sel_page_start = 1
            sel_page_end = Selection.Sections(1).Range.Information(wdActiveEndPageNumber)
        End If
        
        Call StringSearch(i)
        ' Call PDFdruck  
        MsgBox "Dokument: " & start_section_index & " mit den Seiten: " & sel_page_start & "-" & sel_page_end  
    End With
Next i

End Sub

Function StringSearch(i)

ActiveDocument.Sections(i).Headers(wdHeaderFooterPrimary).Range.Select

With Selection.Find
    .ClearFormatting
    .Text = "Dokument"  
    .Forward = True
    Do While .Execute
        Dateiname = ActiveDocument.Range(Selection.End + 1, Selection.End + 15).Text
    Loop
End With

End Function

Wo liegt da nun noch mein Fehler?
Danke schon mal im voraus!

Mit den Collections komme ich an der Stelle nicht mehr weiter. Die Seitenzahlen für die pdf-Erstellung bekomme ich nun korrekt, mittels der Funktion "StringSearch" möchte ich nun aus der Kopfzeile der ersten Seite dieser Section den SuchString ziehen, da ich ihn für den Dateiname brauche. Aber irgendwie steckt da noch ein Fehler drin. Was mache ich da falsch?

Gruß Torsten

So kann ich ja den Suchstring in den Kopfzeilen finden.

For i = 2 To ActiveDocument.Sections.Count

ActiveDocument.Sections(i).Headers(wdHeaderFooterPrimary).Range.Select

With Selection.Find
    .ClearFormatting
    .Text = "Mein Suchstring."  
    .Forward = True
    Do While .Execute
        MeinString = .Text
    Loop
End With

Ich habe aber hier in der "Do While"-Schleife nicht die Möglichkeit bestimmte Zeichen (von-bis) nach dem Suchstring in eine Variable zu speichern, da hier irgendwas in der Art: Range(Selection.End + 1, Selection.End + 13).Text nicht funktioniert, da ich mich hier nicht an der Position des gefunden Suchstrings befindet, sondern in der gesamten Selection, also der Kopfzeile.

Wie komme ich hier an den Text nach dem gefundenen Suchstring? "Select" usw. gibt es hier nicht.

gelöst Frage VB for Applications Entwicklung

Mehr von goodbytes

NTP im Netzwerkgoodbytes - 8 Kommentare

Tool für IT-Dokumentationgoodbytes - 13 Kommentare

Vba transparentes textfeld über jede zelle in einem Bereich legengoodbytes - 6 Kommentare

SQL - mehrere UPDATE-Anweisungen in einem String per vbsgoodbytes - 4 Kommentare

Heiß diskutiert