Absatz finden, der oberhalb einer Tabelle steht

[M.Dietz]

Hi,

Lange her, dass ich hier gepostet habe, aber mein Account ist noch aktiv Allerdings kann ich mich daran erinnern, dass es eine spezifische Sektion für Office-Probleme (VBA, Excel-Formeln etc) gab, die finde ich nicht mehr, daher poste ich das mal unter VB

Für die Erzeugung eines Excel-Formulars (Sitzungsprotokoll) muss ich einen automatisch als RTF erzeugten Report auslesen. Dieser ist in seinen Abschnitten immer gleich aufgeteilt:

• Titel der Sektion
• Leerzeile
• Sektionsabhängiger Tabellenheader
• Tabelle (1-n Zeilen)
• begleitender aber für das Protokollformular irrelevanter Text (mehrere Absätze möglich)

Die Idee war nun, durch die Tables-Liste zu iterieren, und jeweils die entsprechenden Absätze von dort aus zu suchen.

    Set wordApp = CreateObject("Word.Application")
    Set rapportDoc = wordApp.Documents.Open(fileName, ReadOnly:=True, Visible:=False)
    On Error GoTo ReleaseAll
    
    startingRow = FindFirstEmptyRow()
    startingRow = startingRow + 2
    AddProtocolHeader (startingRow)
    
    For tableNo = 1 To rapportDoc.Tables.Count
        'fill in section name
        Set workRng = rapportDoc.Tables(tableNo).Range
        workRng.Move Unit:=wdParagraph, Count:=-3
        workRng.Paragraphs(1).Range.Copy
        ActiveCell.PasteSpecial xlPasteValues
        ActiveCell.Font.Bold = True

        'fill in section specific table header
        workRng.Move Unit:=wdParagraph, Count:=2
        workRng.Paragraphs(1).Range.Copy
        ActiveCell.Offset(1, 0).Select
        ActiveCell.PasteSpecial xlPasteValues

        'fill in table
        rapportDoc.Tables(tableNo).Range.Copy
        ActiveCell.Offset(1, 0).Select
        ActiveCell.PasteSpecial xlPasteValues
        
       ' Auswertung der Tabellen für Default-Werte entfernt (nicht relevant für diese Frage)

        ActiveCell.Offset(2, 0).Select
        
    Next
    
ReleaseAll:
    rapportDoc.Close (wdDoNotSaveChanges)
    wordApp.Quit
    Set wordApp = Nothing
    Range("A" & startingRow).Select

Den Code habe ich in einer ähnlichen Form im Internet gefunden, wenn es darum geht, die erste Zeile NACH einer Tabelle zu finden (das scheint aber ein vielgefragter Usecase zu sein, vermutlich weil die Tabellentitel eher als Unterschrift bestehen als als Überschrift). Ich musste allerdings feststellen, dass die Tabellengröße anscheinend eine Rolle spielt, wenn man nach oben will, also habe ich den Anfang etwas abgeändert:

        Set workRng = rapportDoc.Tables(tableNo).Range
        workRng.Move Unit:=wdParagraph, Count:=-rapportDoc.Tables(tableNo).Rows.Count
        workRng.Move Unit:=wdParagraph, Count:=-3
        workRng.Paragraphs(1).Range.Copy
        ActiveCell.PasteSpecial xlPasteValues
        ActiveCell.Font.Bold = True

Das klappt jetzt zwar für korrekt ausgefüllte Tabellen ab 2 Zeilen Länge, aber spätestens wenn ich Leerzeilen am Ende der Tabelle habe habe, oder die Tabelle nur aus einer Zeile besteht (0 Zeilen geht nicht, dann würde, wenn ich meinen Chef richtig verstanden habe, der Abschnitt und damit die Tabelle gar nicht erst erzeugt), liest das Makro nicht mehr den richtigen Absatz aus, und ich bekomme leere Zellen, wo eigentlich der Sektionsname oder der sektionsabhängige Tabellenheader stehen sollte

Um jetzt zu vermeiden, dass ich für jeden Sonderfall eine neue Behandlung einprogrammieren muss, wollte ich nachfragen, ob es einfach möglich ist, sich in der ersten Zeile schon direkt vor die Tabelle zu setzen, oder zumindest dies in der zweiten Zeile (ohne Notwendigkeit, Probleme der Tabelle an sich selbst zu behandeln) zu gestalten, damit ich von dort aus einfach die 3 Absätze nach oben kann.

Bevorzugte Alternativlösung wäre, den ersten Absatz oberhalb der Tabelle zu finden, der als Überschrift1 formattiert ist (Sektionsname) bzw. als Überschrift2 (sektionsabhängiger Tabellenheader), das ist sicherer (falls jemals das Erzeugerskript geändert wird und weitere Leerzeilen erzeugt werden), aber da habe ich erst recht keine Ahnung, wie man dies per VBA bewerkstelligen kann.

Ist jetzt viel Text gewesen, ich bedanke mich schon mal fürs Durchlesen, und freue mich auf Vorschläge.
Gruß
Martin

Edit:
Ich hab mal noch ein bisschen mehr gegoogelt, und bin auf folgendes gestoßen:

With workRng.Find
            .ClearFormatting
            .Format = True
            .Style = rapportDoc.Styles("Überschrift 1")
            .Text = ""
            .Forward = False
            .Wrap = wdFindContinue
            .Execute
        End With

Wusste gar nicht, dass man in Word auch nach Formatierungen suchen kann... Jedenfalls klappt es damit, das Problem ist also erstmal behoben.