How to verify blank elements in MS Word by macro

[Sam1085]

Hi,

I think we can add blank pages to a word document using several methods.

01. Blank paragraphs characters or non printable characters
02. Two section breaks
03. Two page breaks
04. Page break before

Is it possible to findout blank pages and mark them as word comment?

Blank page = Non Printable characters
Non Blank page = Printable characters + Hidden Characters

Second thing is in some documents have empty text content controllers. Is there any way to inspect all empty text content controllers by VBA?

Thanks!

[macropod]

I'm not sure what the point is for commenting blank pages, but you could use something like:

Code: Select all

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, RngSel As Range, Rng As Range, bCmnt As Boolean
With ActiveDocument
  Set RngSel = Selection.Range
  For i = 1 To .ComputeStatistics(wdStatisticPages)
    Set Rng = .GoTo(What:=wdGoToPage, Name:=i): bCmnt = False
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
    With Rng
      If Len(.Text) = 1 Then
        bCmnt = True
      Else
        With .Find
          .ClearFormatting
          .Replacement.ClearFormatting
          .Text = "[^s^t^l^13^32]{1,}"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindStop
          .Format = False
          .MatchWildcards = True
          .Execute Replace:=wdReplaceAll
        End With
        If .Find.Found Then
          If Len(.Text) <= 1 Then bCmnt = True
          If Len(.Text) = .Sections.Count Then bCmnt = True
          ActiveDocument.Undo
        End If
      End If
    End With
    If bCmnt = True Then
      .Comments.Add Rng.Characters.First, "Blank Page"
    End If
  Next i
  RngSel.Select
  Set Rng = Nothing: Set RngSel = Nothing
End With
Application.ScreenUpdating = True
End Sub

For content text & dropdown controls, you could test whether they're displaying their placeholder text. For example:

Code: Select all

Sub Demo()
Application.ScreenUpdating = False
Dim CCtrl As ContentControl
For Each CCtrl In ActiveDocument.ContentControls
  With CCtrl
    Select Case .Type
      Case wdContentControlComboBox, wdContentControlDate, wdContentControlDropdownList, _
        wdContentControlRichText, wdContentControlText
        If .ShowingPlaceholderText = True Then MsgBox "not filled in"
      Case Else
    End Select
  End With
Application.ScreenUpdating = True
End Sub

[Sam1085]

Many thanks Paul,

I've changed your very first code per below to identify blank pages given by 'Paragraph Breaks'. This is perfect!!
[^s^n^t^l^13^32]{1,}

In second thing, In my document doesn't contains placeholder text every time. Some content controllers have blank spaces (^013 or non breaking spaces). Do you have any idea to inspect them by word comment?

Thanks!

[HansV]

Try this version of Paul's macro:

Code: Select all

Sub MarkEmptyControls()
    Dim CCtrl As ContentControl
    Dim rng As Range
    Dim s As String
    Application.ScreenUpdating = False
    For Each CCtrl In ActiveDocument.ContentControls
        With CCtrl
            Select Case .Type
                Case wdContentControlComboBox, wdContentControlDate, _
                        wdContentControlDropdownList, _
                        wdContentControlRichText, wdContentControlText
                    If .ShowingPlaceholderText = True Then
                        Set rng = CCtrl.Range
                        Set rng = ActiveDocument.Range(rng.End + 1, rng.End + 1)
                        ActiveDocument.Comments.Add _
                            Range:=rng, Text:="Empty ContentControl!"
                    Else
                        Set rng = CCtrl.Range
                        s = rng.Text
                        s = Replace(s, vbCr, "")
                        s = Replace(s, Chr(160), "")
                        s = Trim(s)
                        If s = "" Then
                            Set rng = ActiveDocument.Range(rng.End + 1, rng.End + 1)
                            ActiveDocument.Comments.Add _
                                Range:=rng, Text:="ContentControl contains spaces!"
                        End If
                    End If
            End Select
        End With
    Next CCtrl
    Application.ScreenUpdating = True
End Sub

[Sam1085]

Hi Hans,

Thank you for the update.

I just tried that in my document. But it's marked all content controllers like below screen shot.

img1.png

[HansV]

I can't explain that. When I run the macro, it leaves content controls that contain text (other than the placeholder text) alone.

S278.png

[Sam1085]

Hi Hans,

I just check the code again in Word 2010. But I got the same result as previous. I'll check this with word 2016 and confirm.
Thanks!

[HansV]

I have tested the code in Word 2010 and Word 2016. In both, the result was as in the screenshot in my previous reply.

[Sam1085]

Okay,

I attached sample file here. Kindly please can check it again for me.

Sample Document.docx

My word version is word 2010 32-bit (Office 14.0.7172.5000).

Thanks!

[HansV]

I do see the behavior that you describe in your document. The text in the first content control is the placeholder text:

S1231.png

That's why the macro treats it as empty.

[Sam1085]

I got that point. I added rich text content controls in my sample document. That's the reason.

Can ignore content included rich text content controls and plain content controls (Both)?

[HansV]

Code: Select all

Sub MarkEmptyControls()
    Dim CCtrl As ContentControl
    Dim rng As Range
    Dim s As String
    Application.ScreenUpdating = False
    For Each CCtrl In ActiveDocument.ContentControls
        With CCtrl
            Select Case .Type
                Case wdContentControlComboBox, wdContentControlDate, _
                        wdContentControlDropdownList, wdContentControlText
                    If .ShowingPlaceholderText = True Then
                        Set rng = CCtrl.Range
                        Set rng = ActiveDocument.Range(rng.End + 1, rng.End + 1)
                        ActiveDocument.Comments.Add _
                            Range:=rng, Text:="Empty ContentControl!"
                    Else
                        Set rng = CCtrl.Range
                        s = rng.Text
                        s = Replace(s, vbCr, "")
                        s = Replace(s, Chr(160), "")
                        s = Trim(s)
                        If s = "" Then
                            Set rng = ActiveDocument.Range(rng.End + 1, rng.End + 1)
                            ActiveDocument.Comments.Add _
                                Range:=rng, Text:="ContentControl contains spaces!"
                        End If
                    End If
                Case wdContentControlRichText
                    Set rng = CCtrl.Range
                    s = rng.Text
                    s = Replace(s, vbCr, "")
                    s = Replace(s, Chr(160), "")
                    s = Trim(s)
                    If s = "" Then
                        Set rng = ActiveDocument.Range(rng.End + 1, rng.End + 1)
                        ActiveDocument.Comments.Add _
                            Range:=rng, Text:="ContentControl contains spaces!"
                    End If
           End Select
        End With
    Next CCtrl
    Application.ScreenUpdating = True
End Sub

[Sam1085]

Thanks Sir!

It works perfectly.