Office: ausgeblendete Zeilen nicht berücksichtigen

Hallo Ihr Wissenden!

Mein Chef meint ich soll mich mal bei den bestehenden Macros schlau machen und diese vom Vorgänger etwas verändern. Die Aufgabe ist dabei nun, bei der Erstellung eines Abkürzungsverzeichnisses die "ausgeblendeten" Zeilen nicht zu berücksichtigen.
Wie bekommen ich im bestehendem Word-Macro nun den Wert raus, dass dies ein ausgeblendeter Text bzw. eine Zeile ist? Ich hätte hier leider noch nicht ähnliches gefunden.

VIELEN DANK zunächst MAL!!!

 

Da müsste man das Makro sehen und auch wissen, mit welcher Technik das Abküverz erstellt wird.

Gruß
G. O.

 

Hhhhhmmmm ich würde eigentlich nur den Command benötigen, wie ich den Status "hiddentext" aus der eingelesenen Zeile bekommen. Hierzu ein Macroauszug:

Sub erstelleAbkuerzungsVZ()
'check ob AbkVZ existiert
'wenn nein -> Einfügen an aktueller Stelle?
Dim abkVz As Variant
Dim vzGesamt As Variant
Dim regex As New RegExp
abkVzFound = False
abkVzGesamtFound = False
Set meinDokument = ActiveDocument
count = 1

'wenn ausgeblendeter Text -> ignorieren
EinlesenZeile = False
Drucktext = False
Options.PrintHiddenText = True



For Each tbl In meinDokument.Tables

If tbl.Title = "Abkuerzungsverzeichnis" Then
'dsth
abkVzFound = True
abkVz = count

ElseIf tbl.Title = "AbkuerzungsverzeichnisGesamt" Then
'dsth
abkVzGesamtFound = True
vzGesamt = count
End If
count = count + 1
Next tbl

If abkVzGesamtFound = False Then

MsgBox Prompt:= _
"Es wurde kein gesamtes Abkürzungsverzeichnis gefunden. Bitte das gesamte Abkürzungsverzeichnis an die letzte Stelle im Dokument kopieren, die Tabelle makieren -> Schriftart -> Text -> Effekte -> Ausblenden. Anschließend der Tabelle den Titel 'AbkuerzungsverzeichnisGesamt' geben.", Title:="Fehler - keine AbkVzGesamt"

End If

If abkVzFound = False Then

meinDokument.Range(userSelection, userSelection).Select
msgb = MsgBox("Es wurde keine AbkuerzungsVerzeichnis gefunden! Soll das Verzeichnis an der aktuellen Position eingefügt werden?", vbYesNo, "Fehler - keine AbkVZ")
If msgb = vbYes Then
'selection tableeinfügen

End If
End If




If abkVzFound = True And abkVzGesamtFound = True Then
' Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.StatusBar = " Bitte warten - Suche startet. "

totalSteps = meinDokument.Tables(vzGesamt).Rows.count

'alle rows bis auf headerzeile von abkVz löschen
x = meinDokument.Tables(abkVz).Rows.count - 1
For i = 1 To x
meinDokument.Tables(abkVz).Rows(meinDokument.Tables(abkVz).Rows.count).Delete
Next i

For r = 2 To meinDokument.Tables(vzGesamt).Rows.count
'positioniieren vor abkVz
'search nach oben


pos = meinDokument.Tables(abkVz).Range.Start
meinDokument.Range(pos, pos).Select

abkF = False
abk = meinDokument.Tables(vzGesamt).Cell(r, 1).Range.text
abk = Left(abk, Len(abk) - 2)
'-2 wegen breakline? besser durch regex oder nur alphanumerisch ersetzen ...


Application.StatusBar = "Suchfortschritt - " & Round((r * 100) / (totalSteps), 0) & "%"
If abkF = False Then
Set dokument = meinDokument.Range(1, pos)
regex.Pattern = "[^a-zA-Z0-9äÄöÖüÜß]" & abk & "[^a-zA-Z0-9äÄöÖüÜß]"
abkF = regex.Test(dokument)
Drucktext = Options.PrintHiddenText
End If


'für jeden eintrag in VZgesamt das Dokument bis zur Vorletzten Seite durchsuchen
'wenn gefunden -> Eintrag in AbkVZ
If abkF = True And EinlesenZeile = False And Drucktext = True Then



meinDokument.Tables(abkVz).Rows.Add
abkRow = meinDokument.Tables(abkVz).Rows.count
meinDokument.Tables(abkVz).Cell(abkRow, 1).Range.text = meinDokument.Tables(vzGesamt).Cell(r, 1).Range.text
meinDokument.Tables(abkVz).Cell(abkRow, 2).Range.text = meinDokument.Tables(vzGesamt).Cell(r, 2).Range.text
meinDokument.Tables(abkVz).Cell(abkRow, 1).Shading.ForegroundPatternColor = wdColorAutomatic
meinDokument.Tables(abkVz).Cell(abkRow, 1).Shading.BackgroundPatternColor = RGB(255, 255, 255)
meinDokument.Tables(abkVz).Cell(abkRow, 2).Shading.ForegroundPatternColor = wdColorAutomatic
meinDokument.Tables(abkVz).Cell(abkRow, 2).Shading.BackgroundPatternColor = RGB(255, 255, 255)
meinDokument.Tables(abkVz).Cell(abkRow, 1).Range.Bold = False
meinDokument.Tables(abkVz).Cell(abkRow, 2).Range.Bold = False

End If


Next r
Application.StatusBar = ""



meinDokument.Tables(abkVz).Borders.Enable = True
meinDokument.Tables(abkVz).Borders.InsideLineStyle = wdLineStyleSingle
meinDokument.Tables(abkVz).Borders.InsideLineWidth = wdLineWidth075pt
meinDokument.Tables(abkVz).Borders.OutsideLineWidth = wdLineWidth150pt
meinDokument.Tables(abkVz).Borders(wdBorderHorizontal).Color = wdColorBlack



End If

MsgBox "Abkuerzungsverzeichnisprozess erledigt."

 

Hallo Tom,

ob eine komplette Tabellenzeile ( darum handelt es sich ja vermutlich?) verborgen formatiert wurde, kriegst du z.B. so raus:
If meindokument.Tables(abkVz).Rows(i).Range.Font.Hidden = True Then
'....

Wo das in dein Makro passt, kann ich nur vermuten, denn es verwirrt mich ziemlich. Als Anwender würde ich spätestens hier verwundert gucken:
Es wurde kein gesamtes Abkürzungsverzeichnis gefunden. Bitte das gesamte Abkürzungsverzeichnis an die letzte Stelle im Dokument kopieren,...
Aber das wirst du schon selber wissen.
Nur zwei ungefragte Anmerkungen dazu:

• Ich würde eine Variable nicht "count" nennen, denn das ist ein Schlüsselwort in VBA und Verwechslungen sind programmiert.
• Beim Löschen von Tabellenzeilen vom Ende her beginnen, sonst ist die Verwirrung programmiert:

x = meinDokument.Tables(abkVz).Rows.count - 1
For i = x To 1 step -1 ...​

 

Hallo Gerhard,

danke für Dein Feedback, um die Verwirrungen des Vorgängers im Macro muss ich mich später kümmern.

Aber das Ziel des Macros soll sein, dass ein Text im vorderen Bereich eingelesen wird und dann hinten die Tabelle mit dem Abkürzungsverzeichnis erstellt wird. Aktuell fehlt hier aber noch, dass nicht zu druckende Zeilen (sprich hier die ausgeblendete Zeilen bzw. Wörter nicht gedruckt weden) und somit auch nicht im Inhaltsverzeichnis berücksichtigt werden sollen.

Sprich die Tabelle bzw. das Inhaltsverzeichnis, wie oben von Dir angegeben wird aber eh immer gedruckt.
Was NUN TUN :-(

 

Hallo Tom,

"Was NUN TUN"

Am besten noch mal erklären. In meinem Kopf siehts so aus:
Dein Makro erzeugt, wie auch immer, ein Abkürzungsverzeichnis in Tabellenform, von denen einige Zeilen ausgeblendet sind. Die willst du (im Nachhinein?) löschen. Vermutlich hab ich das fehlinterpretiert. Also erklär bitte noch mal:

Was für ausgeblendete Zeilen meinst du (Tabellenzeilen, einzeilige Absätze) und wo stehen die? Und was hat es mit den einzelnen Wörtern auf sich (stehen die mitten im Fließtext oder wo)?

Hilfreich wäre auch, wenn du im Makro die Stelle zeigen könntest, wo die noch fehlenden Codezeilen brauchst.

Am besten erklärst du das alles anhand eines Musterdokuments, damit man überhaupt mal nachvollziehen kann, was das Makro macht.

Vorbeugend sei erklärt, dass ein Musterdokument nicht das Originaldokument sein muss, sondern ein abgespecktes und soweit erforderlich anonymisiertes, das aber von der Struktur her dem Original entspricht, so dass man dein Makro drauf anwenden kann.

 

OK DANKE, ich hab mal ein Dokument erstellt, dass auch die Erklärungen enthält :-)
Aber nur ein docx - ohne Macros, weil hier keine docm hochgeladen werden dürfen.
Das Macro dazu ist oben schon als Text enthalten.

Nun zum Ablauf, eine kleine Korrektur Deiner Zusammenfassung sei erlaubt, wahrscheinlich bled erklärt von mir:
1. Es gibt im Dok mehrere Textpassagen (GELBE UND GRÜNE Textpassagen) und einige davon sind ausgeblendet (GELBE Textpassagen) diese werden auch nicht ausgedruckt.
2. mit dem Macro wird am Ende der Analyse auf Seite 6 ein Abkürzungsverzeichnis generiert
3. das Macro scannt die Textpassagen Seite 2 bis 4 und sucht dabei nach Abkürzungen die im Abkürzungsregister Seite 7 enthalten sind und kopiert Einträge die er in den Textpassagen und im Abkürzungsregister findet (ink. der ausgeblendeten GELBEN Zeilen) in das Abkürzungsverzeichnis
4. im Abkürzungsverzeichnis sollen aber die ausgeblendeten Texte (GELB hinterlegt) nicht aufscheinen, weil diese ja am Ende auch nicht ausgedruckt werden, sondern nur Hinweise bei der Dokumentenerstellung sind.
5. Das Ziel sollte sein, dass das Macro nur die auszudruckenden Abkürzungen (nur die Zeilen in GRÜN) in das Abkürzungsverzeichnis übernehmen soll.
6. Die Textzeilen die ausgeblendet werden und auch nicht gedruckt werden (GELBE ZEILEN), sollen im Abkürzungsverzeichnis nicht aufscheinen.

DANKE DANKE DANKE

 

Hallo Tom,

mit dieser Beschreibung konnte ich schon eher was anfangen. Das Makro selbst war mir trotzdem noch ein Dschungel, u.a. deshalb, weil der Autor nur einige wenige der zahlreichen Variablen deklariert hat und deshalb nicht klar war, welche wofür steht.

Ich hab am Makro - außer der Variablendeklaration - möglichst wenig geändert, nur eins:

Die Stelle, wo per Regex.text ermittelt wird, ob eine Abkürzung im Dokument existiert, hab ich ersetzt durch einen Suchprozess (dokument.find). Grund: Regex.text sagt nichts drüber aus, wo im Dokument eine Abkürzung gefunden wurde. Diese Information braucht man aber, um untersuchen zu können, ob die Textstelle verborgen formatiert ist.
Diese Passage hab ich im Makro mit Sternchen gekennzeichnet.
Getestet hab ich nur den Fall, wo die Abkürzungstabelle bereits besteht. Die andere ist, soweit ich das gerafft habe, auch gar nicht ausgearbeitet.

Code:

Option Explicit

Sub erstelleAbkuerzungsVZ()
'check ob AbkVZ existiert
'wenn nein -> Einfügen an aktueller Stelle?
Dim abkVz As Variant, vzGesamt As Variant
Dim regex As New RegExp
Dim anZahl As Long, totalsteps As Long, pos As Long, x As Long, i As Long, r As Long
Dim abkRow As Long, msgb As Long
Dim einlesenZeile As Boolean, Drucktext As Boolean, abkf As Boolean
Dim abkVzFound As Boolean, abkVzGesamtFound As Boolean, verborgen As Boolean
Dim abk As String
Dim meinDokument As Document
Dim dokument As Range, fundstelle As Range
Dim tbl As Table

abkVzFound = False
abkVzGesamtFound = False
Set meinDokument = ActiveDocument
anZahl = 1

'wenn ausgeblendeter Text -> ignorieren
einlesenZeile = False
Drucktext = False
Options.PrintHiddenText = True

    For Each tbl In meinDokument.Tables
  
        If tbl.Title = "Abkuerzungsverzeichnis" Then
            'dsth
            abkVzFound = True
            abkVz = anZahl
      
        ElseIf tbl.Title = "AbkuerzungsverzeichnisGesamt" Then
            'dsth
            abkVzGesamtFound = True
            vzGesamt = anZahl
        End If
      
        anZahl = anZahl + 1
    Next tbl

    If abkVzGesamtFound = False Then
  
        MsgBox Prompt:= _
        "Es wurde kein gesamtes Abkürzungsverzeichnis gefunden. " & vbLf & _
        "Bitte das gesamte Abkürzungsverzeichnis an die letzte Stelle im Dokument kopieren, die Tabelle makieren -> Schriftart -> Text -> Effekte -> Ausblenden. Anschließend der Tabelle den Titel 'AbkuerzungsverzeichnisGesamt' geben.", Title:="Fehler - keine AbkVzGesamt"
    End If

    If abkVzFound = False Then
  
        'meinDokument.Range(userselection, userselection).Select
        meinDokument.Range(0, 0).Select
        msgb = MsgBox("Es wurde keine AbkuerzungsVerzeichnis gefunden! Soll das Verzeichnis an der aktuellen Position eingefügt werden?", vbYesNo, "Fehler - keine AbkVZ")
            If msgb = vbYes Then
                'selection tableeinfügen
            End If
    End If

If abkVzFound = True And abkVzGesamtFound = True Then
    ' Application.ScreenUpdating = False
    Application.DisplayStatusBar = True
    Application.StatusBar = " Bitte warten - Suche startet. "

    totalsteps = meinDokument.Tables(vzGesamt).Rows.Count

    'alle rows bis auf headerzeile von abkVz löschen
    x = meinDokument.Tables(abkVz).Rows.Count - 1

        For i = 1 To x
            meinDokument.Tables(abkVz).Rows(meinDokument.Tables(abkVz).Rows.Count).Delete
        Next i

        For r = 2 To meinDokument.Tables(vzGesamt).Rows.Count
            'positioniieren vor abkVz
            'search nach oben


            pos = meinDokument.Tables(abkVz).Range.Start
            meinDokument.Range(pos, pos).Select
          
            abkf = False
          
          
            abk = meinDokument.Tables(vzGesamt).Cell(r, 1).Range.Text
            abk = Left(abk, Len(abk) - 2)
            '-2 wegen breakline? besser durch regex oder nur alphanumerisch ersetzen ...
          
            Application.StatusBar = "Suchfortschritt - " & Round((r * 100) / (totalsteps), 0) & "%"
                If abkf = False Then
                    Set dokument = meinDokument.Range(1, pos)
                   '******neu****************************************************************************
                    With dokument.Find
                        .Text = abk
                        .Execute
                            If .Found = True Then
                                abkf = True
                                Set fundstelle = dokument
                                verborgen = fundstelle.Font.Hidden
                            End If
                    End With
                '******************************************************************************************  
'                        regex.Pattern = "[^a-zA-Z0-9äÄöÖüÜß]" & abk & "[^a-zA-Z0-9äÄöÖüÜß]"
'                        abkf = regex.Test(dokument)
                    Drucktext = Options.PrintHiddenText
                End If

            'für jeden eintrag in VZgesamt das Dokument bis zur Vorletzten Seite durchsuchen
            'wenn gefunden -> Eintrag in AbkVZ
            If abkf = True And einlesenZeile = False And Drucktext = True And verborgen = False Then
              
              
                meinDokument.Tables(abkVz).Rows.Add
                abkRow = meinDokument.Tables(abkVz).Rows.Count
                meinDokument.Tables(abkVz).Cell(abkRow, 1).Range.Text = meinDokument.Tables(vzGesamt).Cell(r, 1).Range.Text
                meinDokument.Tables(abkVz).Cell(abkRow, 2).Range.Text = meinDokument.Tables(vzGesamt).Cell(r, 2).Range.Text
                meinDokument.Tables(abkVz).Cell(abkRow, 1).Shading.ForegroundPatternColor = wdColorAutomatic
                meinDokument.Tables(abkVz).Cell(abkRow, 1).Shading.BackgroundPatternColor = RGB(255, 255, 255)
                meinDokument.Tables(abkVz).Cell(abkRow, 2).Shading.ForegroundPatternColor = wdColorAutomatic
                meinDokument.Tables(abkVz).Cell(abkRow, 2).Shading.BackgroundPatternColor = RGB(255, 255, 255)
                meinDokument.Tables(abkVz).Cell(abkRow, 1).Range.Bold = False
                meinDokument.Tables(abkVz).Cell(abkRow, 2).Range.Bold = False
         End If
    Next r
    Application.StatusBar = ""
  
    meinDokument.Tables(abkVz).Borders.Enable = True
    meinDokument.Tables(abkVz).Borders.InsideLineStyle = wdLineStyleSingle
    meinDokument.Tables(abkVz).Borders.InsideLineWidth = wdLineWidth075pt
    meinDokument.Tables(abkVz).Borders.OutsideLineWidth = wdLineWidth150pt
    meinDokument.Tables(abkVz).Borders(wdBorderHorizontal).Color = wdColorBlack

End If
End Sub