Sub ShowColumnInfo()
Dim doc As Document
Dim i As Integer
Dim Sec As Section
Dim str As String, strColBk As String
Set doc = ActiveDocument
For Each Sec In doc.Sections
i = i + 1
If (CInt(CountWordPhrase(i, doc)) > 0) Then
strColBk = CountWordPhrase(i, doc)
str = str & vbCrLf & "Section: " & i & " Columns " & Sec.PageSetup.TextColumns.Count & "- " & "ColumnBreaks (" & strColBk & "), "
End If
Next
MsgBox "Column Break Info:" & str, vbInformation, "Column break info per section"
End Sub
Private Function CountWordPhrase(SecId As Integer, myDoc As Document) As String
Dim x As String
Dim y As Integer
On Error Resume Next 'not really recommended but problems can happen on finds
x = "^n" 'column break text
myDoc.Sections(SecId).Range.Select
With Selection.Find
Do While .Execute(FindText:=x, Forward:=True, Format:=True, _
MatchWholeWord:=True) = True
y = y + 1
Loop
End With
CountWordPhrase = CStr(y)
End Function
|