vbams-wordcontentcontrol

MsgBox if ContentControl input left unanswered


I have an MS Word document where I require users to pick a numerical value from 1-5, in various ContentControls for several questions.
I have a button named Calculate in the doc. When users click this button the code calculates an average of their inputs and enters the result in various bookmarked cells.

This works except when some ContentControls are left blank. I want a pop-up box to appear when one or more ContentControl inputs have not been answered.

Private Sub Calculate_Click()
    Dim ccs1 As ContentControls
    Dim cc1 As ContentControl
    Dim content1 As String
    Dim ccs2 As ContentControls
    Dim cc2 As ContentControl
    Dim content2 As String
    Dim MissingData As String
    Dim TotalRating As Double
    Dim OrgRating As Double
    Dim TeamRating As Double
    Dim StratRating As Double
    Dim PandPRating As Double
    Dim EvidenceRating As Double
    Dim ESGRating As Double
    
    ' Error if Rating1 to Rating 19 are PlaceholderText
    For i = 1 To 19
        TagName1 = "Rating" & i
        TagName2 = "RT" & i
        Set doc = ActiveDocument
        Set ccs1 = doc.SelectContentControlsByTag(TagName1)
        Set cc1 = ccs1(1)
        content1 = cc1.Range
        Set ccs2 = doc.SelectContentControlsByTag(TagName2)
        Set cc2 = ccs2(1)
        content2 = cc2.Range

        If content1 = cc1.PlaceholderText Then
            MissingData = MissingData & vbCrLf & "- " & content2
        End If
    Next i
    
    If MissingData <> "" Then
        MsgBox "Please enter the following before submitting:" & MissingData
        End
    End If
    
    Call updateDouble(ActiveDocument, "Rating", 1, 18, "TotalRating")
    Call updateDouble(ActiveDocument, "Rating", 1, 4, "OrgRating")
    Call updateDouble(ActiveDocument, "Rating", 5, 7, "TeamRating")
    Call updateDouble(ActiveDocument, "Rating", 8, 10, "StratRating")
    Call updateDouble(ActiveDocument, "Rating", 11, 14, "PandPRating")
    Call updateDouble(ActiveDocument, "Rating", 15, 18, "EvidenceRating")
    Call updateDouble(ActiveDocument, "Rating", 19, 19, "ESGRating")
    
End Sub

Private Sub updateDouble(doc As Word.Document, CCTitlePrefix As String, _StartNum As Integer, EndNum As Integer, CellName As String)
    Dim i As Integer
    Dim Total As Double
    Total = 0
    With doc
        For i = StartNum To EndNum
            Total = Total + CDbl(.SelectContentControlsByTitle(CCTitlePrefix & CStr(i))(1).Range.Text)
        Next
        .Bookmarks(CellName).Range.Paragraphs(1).Range.Text = CStr(Total / (1 + (EndNum - StartNum)))
    End With
End Sub

The commented out line is the start of the error handling.
I get no MsgBox pop-up and the code fails to calculate the averages.


Solution

  • Try changing

    If content1 = cc1.PlaceholderText Then
      MissingData = MissingData & vbCrLf & "- " & content2
    End If
    

    to

    If cc1.ShowingPlaceholderText Then
      MissingData = MissingData & vbCrLf & "- " & content2
    End If