Create Word table with text - vba

Question

I would like to reformat an existing and recurring document.
The document is available in two almost identical versions.
The script should search the whole document for the word "ColumnA" and set a starting point for the table behind it.
Then it should search for the word "ContinuousText" or a "Page Break" and create an end point for the table before that.
This is also the difference between the two documents. One has more text (ContinuousText) and the other has no more text but only a "Page Break".
My script works fine when I have "ColumnA" and "ContinuousText".
How do I insert a if there is no "ContinuousText" - looking for "Page Break" query?
This is the scipt that works ("ColumnA" and "ContinuousText")
Sub SlideNoteToTable()
' -----------------< Create Table >-----------------
Dim suchBereich As Range, TabBereich As Range, tabelle As Table
Dim collStart As Collection, collEnd As Collection
Dim d As Long
Set collStart = New Collection: Set collEnd = New Collection
'Collect starting points for the table areas (ColumnA- Ende)
Set suchBereich = ActiveDocument.Range
With suchBereich.Find
.Text = "ColumnA"
Do While .Execute
collStart.Add suchBereich.Paragraphs(1).Range.End + 1
Loop
End With
' Endpunkte für die Tabellenbereiche sammeln (ContinuousText- Text Start)
Set suchBereich = ActiveDocument.Range
With suchBereich.Find
.Text = "ContinuousText"
Do While .Execute
collEnd.Add suchBereich.Start - 1
Loop
End With
'Convert areas to table
For d = collStart.Count To 1 Step -1
Set TabBereich = ActiveDocument.Range(collStart(d), collEnd(d))
Set tabelle = TabBereich.ConvertToTable(Separator:=wdSeparateByParagraphs, NumColumns:=2, AutoFitBehavior:=wdAutoFitWindow)
With tabelle
'all table formatting operations
.AllowAutoFit = False
.PreferredWidthType = wdPreferredWidthPoints
.Borders.Enable = True
.Rows(1).HeadingFormat = True
.Columns(1).SetWidth ColumnWidth:=.PreferredWidth * 2 / 3, RulerStyle:=wdAdjustProportional
End With
Next d
' -----------------< Delete empty tables >-----------------
Dim tabelleX As Table, zeile As Row
For Each tabelleX In ActiveDocument.Tables
For Each zeile In tabelleX.Rows
If Len(zeile.Range) = 4 Then 'there's nothing in it but an empty paragraph mark
zeile.Delete
End If
Next zeile
Next tabelleX
End Sub
I tried to solve the problem pragmatically by simply changing:
.Text = "ContinuousText"
to
.Text = "ContinuousText" Or "^m"
Okay, you can stop laughing now.
I've noticed that it's not quite that easy. But how do I get such an "or" query?
Many thanks for your help.

Answer 1

You cannot use anything like:
.Text = "ContinuousText" Or "^m"
or
.Text = "ContinuousText" Or .Text = "^m"
As a VBA Find expression.
As described in my answer to your other thread on the related issue, you could use two wildcard Find loops, the first being for:
.Text = "ColumnA[!^m]#ContinuousText"
to locate all strings from 'ColumnA' to 'ContinuousText' without an intervening manual page break.
You could then use a separate loop for:
.Text = "ColumnA*^m"
to locate all strings from 'ColumnA' to the next manual page break and couple that with a test on the found range like:
If Instr(.Text, "ContinuousText") = 0 Then
'do the table construction
End If
By putting the code for the table construction in a separate Sub that your main routine calls, you can minimize the code duplication.

Answer 2

I understand your first snippet of code...
.Text = "ContinuousText" Or "^m"
and I have integrated it into the script.
Sub SlideNoteToTable2()
'
' SlideNoteToTable2 Macro
' Formats the speaker text into a two-column table
'
Application.ScreenUpdating = False
' -----------------< Reduce all images proportionally by 40% >-----------------
Dim i As Long
With ActiveDocument.Range
For i = 1 To .InlineShapes.Count
With .InlineShapes(i)
.ScaleHeight = 50
.ScaleWidth = 50
End With
Next i
' ----------------- Locate everything from 'Slide notes' to 'Text Captions' by a Wildcard >-----------------
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Slide notes[!^m]#Text Captions"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
End With
' ----------------- Replacing the two phrases 'Slide notes & Text Captions' with 'Speaker text: & Screen text:' >-----------------
Do While .Find.Execute
.Paragraphs.First.Range.Text = "Speaker text:"
.Paragraphs.Last.Range.Text = "Screen text:" & vbCr
.Start = .Paragraphs.First.Range.End
.End = .Paragraphs.Last.Range.Start
Do While .Characters.First.Text = vbCr
.Characters.First.Delete
Loop
' ----------------- Converting the intervening content to a two-column table >-----------------
With .Duplicate
.Find.Execute FindText:="^13^13", ReplaceWith:="^t^p", Replace:=wdReplaceAll
.ConvertToTable Separator:=vbTab, NumRows:=.Paragraphs.Count, NumColumns:=2, AutoFitBehavior:=wdAutoFitWindow
With .Tables(1)
.AllowAutoFit = False
.PreferredWidthType = wdPreferredWidthPoints
.Borders.Enable = True
.Rows(1).HeadingFormat = True
.Columns(1).SetWidth ColumnWidth:=.PreferredWidth * 3 / 4, RulerStyle:=wdAdjustProportional
Do While .Range.Characters.Last.Next = vbCr
.Range.Characters.Last.Next.Delete
Loop
End With
End With
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
I don't know what to do with the other two snippets of code and where to put them.
.Text = "ColumnA*^m"
'
If Instr(.Text, "ContinuousText") = 0 Then
'do the table construction
End If
I tried a few things that unfortunately didn't work.
Many thanks for the help,
Kind regards.