Consulting

Results 1 to 12 of 12

Thread: Printing List of Content Control Text

  1. #1
    VBAX Regular
    Joined
    Aug 2018
    Posts
    10
    Location

    Printing List of Content Control Text

    Hi!

    I am a newer to VBA and I am working on a Word project where I have multiple content controls which are titled and tagged. For instance:

    Procedure (Title: Procedure, Tag: 1.1) Rich Text
    Findings (Title: Findings, Tag: 1.1) Rich Text
    Priority (Title: Priority, Tag: 1.1) Drop Down List
    Recommendation (Title: Recommendation, Tag: 1.1) Rich Text


    Procedure (Title: Procedure, Tag: 1.2) Rich Text
    Findings (Title: Findings, Tag: 1.2) Rich Text
    Priority (Title: Priority, Tag: 1.2) Drop Down List
    Recommendation (Title: Recommendation, Tag: 1.2) Rich Text

    I am trying to print a list of the text in the content controls when the following criteria is met:
    Priority is not "N/A"
    Group and list by Priority value (Comment, Low, Moderate, High, Finding)
    Procedure - Recommendation (where the procedure and recommendation have the same tag)

    Currently, I have been working on the following which is basic, but does print the Recommendations that are populated to a new word document in a list. I am having an issue getting the correlation to combine the procedure and recommendation by tag and then list them grouped by priority. Thoughts on the complexity of this task?

    Current code:
    Sub GetCCTags()
    Dim i As Long, ReccOut As String

    Dim Index As String
    With ActiveDocument

    For i = 1 To .ContentControls.Count
    If .ContentControls(i).Title = "Reccomendation" Then
    ReccOut = ReccOut & vbCr & .ContentControls(i).Range.Text

    End If

    Next

    End With
    ReccOut = ReccOut

    Documents.Add
    ActiveDocument.Range.Text = ReccOut

    End Sub

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,585
    Location
    Without access to a document showing where these content controls are in relation to each other, it's impossible to provide specific advice on the code you need. Can you attach a document to a post with some representative data (delete anything sensitive)? You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  3. #3
    VBAX Regular
    Joined
    Aug 2018
    Posts
    10
    Location
    My apologies macropod and thank you for asking for the example, which is attached and is a template with example content controls formatted and tagged.

    Ultimately I am trying to get a list printed to the new document which shows the following titles where the tags are the same, and then grouped by priority in the list:

    Procedure - Recommendation

    Thoughts?
    Attached Files Attached Files

  4. #4
    You haven't made it easier by using common names and tags throughout. It would have been preferable to have used unique titles and tags, however it can be done despite the confusion caused by your spelling of 'Recommendation' in the titles. If the content controls titles are spelled correctly in the live document, you will need to modify the code
    If oCC2.Title = "Reccomendation" And oCC2.Tag = .ContentControls(i).Tag Then
    to reflect the correct spelling of Recommendation.

    Note the code goes in a normal module and not the ThisDocument module.

    Option Explicit
    
    Sub GetCCTags()
    Dim i As Long
    Dim oCC As ContentControl, oCC2 As ContentControl
    Dim cComment As Collection
    Dim cLow As Collection
    Dim cModerate As Collection
    Dim cHigh As Collection
    Dim cFinding As Collection
    Dim strRecommendation As String
    Dim oSource As Document
    Dim oDoc As Document
    Dim oRng As Range
    
        Set cComment = New Collection
        Set cLow = New Collection
        Set cModerate = New Collection
        Set cHigh = New Collection
        Set cFinding = New Collection
    
        Set oSource = ActiveDocument
    
        With oSource
            For i = 1 To .ContentControls.Count
                If .ContentControls(i).Title = "Priority" Then
                    For Each oCC In oSource.ContentControls
                        strRecommendation = ""
                        If oCC.Title = "Procedure" And oCC.Tag = .ContentControls(i).Tag Then
                            strRecommendation = oCC.Range.Text
                            For Each oCC2 In oSource.ContentControls
                                If oCC2.Title = "Reccomendation" And oCC2.Tag = .ContentControls(i).Tag Then
                                    strRecommendation = strRecommendation & vbTab & "-" & Chr(9) & oCC2.Range.Text
                                    Exit For
                                End If
                            Next oCC2
                            Exit For
                        End If
                    Next oCC
                    Select Case .ContentControls.Item(i).Range.Text
                        Case "Comment": cComment.Add strRecommendation
                        Case "Low": cLow.Add strRecommendation
                        Case "Moderate": cModerate.Add strRecommendation
                        Case "High": cHigh.Add strRecommendation
                        Case "Finding": cFinding.Add strRecommendation
                    End Select
                End If
            Next i
        End With
        Set oDoc = Documents.Add
        If cComment.Count > 0 Then
            Set oRng = oDoc.Range
            oRng.Collapse 0
            oRng.Text = "Comment"
            oRng.Style = "Heading 1"
            oRng.InsertParagraphAfter
            oRng.End = oDoc.Range.End
            oRng.Collapse 0
            oRng.Style = "Normal"
            For i = 1 To cComment.Count
                oRng.Text = cComment(i) & vbCr
                oRng.Collapse 0
            Next i
        End If
        If cLow.Count > 0 Then
            Set oRng = oDoc.Range
            oRng.Collapse 0
            oRng.Text = "Low"
            oRng.Style = "Heading 1"
            oRng.InsertParagraphAfter
            oRng.End = oDoc.Range.End
            oRng.Collapse 0
            oRng.Style = "Normal"
            For i = 1 To cLow.Count
                oRng.Text = cLow(i) & vbCr
                oRng.Collapse 0
            Next i
        End If
        If cModerate.Count > 0 Then
            Set oRng = oDoc.Range
            oRng.Collapse 0
            oRng.Text = "Moderate"
            oRng.Style = "Heading 1"
            oRng.InsertParagraphAfter
            oRng.End = oDoc.Range.End
            oRng.Collapse 0
            oRng.Style = "Normal"
            For i = 1 To cModerate.Count
                oRng.Text = cModerate(i) & vbCr
                oRng.Collapse 0
            Next i
        End If
        If cHigh.Count > 0 Then
            Set oRng = oDoc.Range
            oRng.Collapse 0
            oRng.Text = "High"
            oRng.Style = "Heading 1"
            oRng.InsertParagraphAfter
            oRng.End = oDoc.Range.End
            oRng.Collapse 0
            oRng.Style = "Normal"
            For i = 1 To cHigh.Count
                oRng.Text = cHigh(i) & vbCr
                oRng.Collapse 0
            Next i
        End If
        If cFinding.Count > 0 Then
            Set oRng = oDoc.Range
            oRng.Collapse 0
            oRng.Text = "Finding"
            oRng.Style = "Heading 1"
            oRng.InsertParagraphAfter
            oRng.End = oDoc.Range.End
            oRng.Collapse 0
            oRng.Style = "Normal"
            For i = 1 To cFinding.Count
                oRng.Text = cFinding(i) & vbCr
                oRng.Collapse 0
            Next i
        End If
    lbl_exit:
        Set oDoc = Nothing
        Set oRng = Nothing
        Set oCC = Nothing
        Set cComment = Nothing
        Set cLow = Nothing
        Set cModerate = Nothing
        Set cHigh = Nothing
        Set cFinding = Nothing
        Exit Sub
    End Sub
    Attached Files Attached Files
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Regular
    Joined
    Aug 2018
    Posts
    10
    Location
    Quote Originally Posted by gmayor View Post
    You haven't made it easier by using common names and tags throughout. It would have been preferable to have used unique titles and tags, however it can be done despite the confusion caused by your spelling of 'Recommendation' in the titles. If the content controls titles are spelled correctly in the live document, you will need to modify the code
    If oCC2.Title = "Reccomendation" And oCC2.Tag = .ContentControls(i).Tag Then
    to reflect the correct spelling of Recommendation.

    Note the code goes in a normal module and not the ThisDocument module.
    Gmayor,

    Duly noted about the misspelling. It will take me a little while to go through to understand the details. I appreciate the time you put into this. One question that I do have is in regards to your last statement. Am I correct in my assessment that since this would be a template doc, inserting the code into ThisDocument would only allow it to run if I am using the document with the code; however, by putting it in the normal module would allow it to be access and run across multiple documents without inserting the code into each one?

  6. #6
    If the document is to be used as a template then save it as a macro enabled template and create new documents from it.
    The ThisDocument module is a particular type of class module primarily aimed at events programming.
    Use an ordinary module for this code.
    ThisDocument is the document or template containing the code that is running.
    ActiveDocument is the currently active document.

    The code I posted uses a Collection for each of the values in the 'Priority' Dropdown, which stores the values associated with that Dropdown value.
    It looks at each 'Priority' Dropdown in turn and then adds the associated values to the appropriate Collection.

    The collection values are them added to the log document in turn with appropriate headings.
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    2,838
    Location
    Graham,

    You can save a little looping by leveraging the SelectContentControlsByTitle collections:

    Sub GetCCTags()
    Dim i As Long
    Dim oCCPri As ContentControls, oCCPro As ContentControls, oCCRec As ContentControls
    Dim oCC1 As ContentControl, oCC2 As ContentControl, OCC3
    Dim cComment As Collection
    Dim cLow As Collection
    Dim cModerate As Collection
    Dim cHigh As Collection
    Dim cFinding As Collection
    Dim strRecommendation As String
    Dim oSource As Document
    Dim oDoc As Document
    Dim oRng As Range
      Set cComment = New Collection
      Set cLow = New Collection
      Set cModerate = New Collection
      Set cHigh = New Collection
      Set cFinding = New Collection
      Set oSource = ActiveDocument
      With oSource
        Set oCCPri = .SelectContentControlsByTitle("Priority")
        Set oCCPro = .SelectContentControlsByTitle("Procedure")
        Set oCCRec = .SelectContentControlsByTitle("Recommendation")
        For Each oCC1 In oCCPri
          For Each oCC2 In oCCPro
            strRecommendation = ""
            If oCC2.Tag = oCC1.Tag Then
              strRecommendation = oCC2.Range.Text
              For Each OCC3 In oCCRec
                If OCC3.Tag = oCC1.Tag Then
                  strRecommendation = strRecommendation & vbTab & "-" & Chr(9) & OCC3.Range.Text
                  Exit For
                End If
              Next OCC3
              Exit For
            End If
          Next oCC2
          Select Case oCC1.Range.Text
            Case "Comment": cComment.Add strRecommendation
            Case "Low": cLow.Add strRecommendation
            Case "Moderate": cModerate.Add strRecommendation
            Case "High": cHigh.Add strRecommendation
            Case "Finding": cFinding.Add strRecommendation
          End Select
          Next oCC1
      End With
      Set oDoc = Documents.Add
      If cComment.Count > 0 Then
        Set oRng = oDoc.Range
        oRng.Collapse 0
        oRng.Text = "Comment"
        oRng.Style = "Heading 1"
        oRng.InsertParagraphAfter
        oRng.End = oDoc.Range.End
        oRng.Collapse 0
        oRng.Style = "Normal"
        For i = 1 To cComment.Count
          oRng.Text = cComment(i) & vbCr
          oRng.Collapse 0
        Next i
      End If
      If cLow.Count > 0 Then
        Set oRng = oDoc.Range
        oRng.Collapse 0
        oRng.Text = "Low"
        oRng.Style = "Heading 1"
        oRng.InsertParagraphAfter
        oRng.End = oDoc.Range.End
        oRng.Collapse 0
        oRng.Style = "Normal"
        For i = 1 To cLow.Count
          oRng.Text = cLow(i) & vbCr
          oRng.Collapse 0
        Next i
      End If
      If cModerate.Count > 0 Then
        Set oRng = oDoc.Range
        oRng.Collapse 0
        oRng.Text = "Moderate"
        oRng.Style = "Heading 1"
        oRng.InsertParagraphAfter
        oRng.End = oDoc.Range.End
        oRng.Collapse 0
        oRng.Style = "Normal"
        For i = 1 To cModerate.Count
          oRng.Text = cModerate(i) & vbCr
          oRng.Collapse 0
        Next i
      End If
      If cHigh.Count > 0 Then
        Set oRng = oDoc.Range
        oRng.Collapse 0
        oRng.Text = "High"
        oRng.Style = "Heading 1"
        oRng.InsertParagraphAfter
        oRng.End = oDoc.Range.End
        oRng.Collapse 0
        oRng.Style = "Normal"
        For i = 1 To cHigh.Count
          oRng.Text = cHigh(i) & vbCr
          oRng.Collapse 0
        Next i
      End If
      If cFinding.Count > 0 Then
        Set oRng = oDoc.Range
        oRng.Collapse 0
        oRng.Text = "Finding"
        oRng.Style = "Heading 1"
        oRng.InsertParagraphAfter
        oRng.End = oDoc.Range.End
        oRng.Collapse 0
        oRng.Style = "Normal"
        For i = 1 To cFinding.Count
          oRng.Text = cFinding(i) & vbCr
          oRng.Collapse 0
        Next i
      End If
    lbl_exit:
      Set oSource = Nothing: Set oDoc = Nothing
      Set oRng = Nothing
      Set oCCPri = Nothing: Set oCCPro = Nothing: Set oCCRec = Nothing:
      Set oCC1 = Nothing: Set oCC2 = Nothing: Set OCC3 = Nothing
      Set cComment = Nothing
      Set cLow = Nothing
      Set cModerate = Nothing
      Set cHigh = Nothing
      Set cFinding = Nothing
      Exit Sub
    End Sub
    Greg

    Visit my website: http://gregmaxey.com

  8. #8
    VBAX Regular
    Joined
    Aug 2018
    Posts
    10
    Location
    Graham,

    My reasoning for using common names and tags was not specific to this particular code, but rather attempting to thing ahead and be able to use the common elements for other routines. Perhaps I was thinking too hard or did something where nothing was needed.

    I am still looking through the code you put together to understand how some of it is working, nonetheless, the code works flawlessly. Thank you

  9. #9
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,585
    Location
    If your content controls had been inserted in a consistent order, you could have used something like:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim i As Long, StrOut As String, wdDoc As Document
    StrOut = "Procedure" & vbTab & "Findings" & vbTab & "Priority" & vbTab & "Recommendation" & vbCr
    With ActiveDocument
      For i = 1 To .SelectContentControlsByTitle("Priority").Count
        If .SelectContentControlsByTitle("Priority")(i).Range.Text <> "N/A" Then
          StrOut = StrOut & .SelectContentControlsByTitle("Procedure")(i).Range.Text & vbTab
          StrOut = StrOut & .SelectContentControlsByTitle("Finding")(i).Range.Text & vbTab
          StrOut = StrOut & .SelectContentControlsByTitle("Priority")(i).Range.Text & vbTab
          StrOut = StrOut & .SelectContentControlsByTitle("Reccomendation")(i).Range.Text & vbCr
        End If
      Next
    End With
    Set wdDoc = Documents.Add
    With wdDoc.Range
      .Text = StrOut
      .ConvertToTable
      With .Tables(1)
        .Rows(1).HeadingFormat = True
        .Rows(1).Range.Font.Bold = True
        .Sort ExcludeHeader:=True, FieldNumber:=3, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
      End With
    End With
    Application.ScreenUpdating = True
    End Sub
    As it is, however, your first "Procedure" is actually 'Test 3', the first "Finding" relates to procedure 4, and the first "Reccomendation" relates to procedure 2, etc. ...
    Cheers
    Paul Edstein
    [MS MVP - Word]

  10. #10
    VBAX Regular
    Joined
    Aug 2018
    Posts
    10
    Location
    Quote Originally Posted by macropod View Post
    If your content controls had been inserted in a consistent order, you could have used something like:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim i As Long, StrOut As String, wdDoc As Document
    StrOut = "Procedure" & vbTab & "Findings" & vbTab & "Priority" & vbTab & "Recommendation" & vbCr
    With ActiveDocument
      For i = 1 To .SelectContentControlsByTitle("Priority").Count
        If .SelectContentControlsByTitle("Priority")(i).Range.Text <> "N/A" Then
          StrOut = StrOut & .SelectContentControlsByTitle("Procedure")(i).Range.Text & vbTab
          StrOut = StrOut & .SelectContentControlsByTitle("Finding")(i).Range.Text & vbTab
          StrOut = StrOut & .SelectContentControlsByTitle("Priority")(i).Range.Text & vbTab
          StrOut = StrOut & .SelectContentControlsByTitle("Reccomendation")(i).Range.Text & vbCr
        End If
      Next
    End With
    Set wdDoc = Documents.Add
    With wdDoc.Range
      .Text = StrOut
      .ConvertToTable
      With .Tables(1)
        .Rows(1).HeadingFormat = True
        .Rows(1).Range.Font.Bold = True
        .Sort ExcludeHeader:=True, FieldNumber:=3, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
      End With
    End With
    Application.ScreenUpdating = True
    End Sub
    As it is, however, your first "Procedure" is actually 'Test 3', the first "Finding" relates to procedure 4, and the first "Reccomendation" relates to procedure 2, etc. ...
    Understood. Out of curiosity, is there a way to do this without the use of the content controls with tags? Just wondering if I took a trip down this path when a shorter, more efficient route was possible.

  11. #11
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,585
    Location
    Yes, you could use code like:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim i As Long, StrOut As String, wdDoc As Document
    StrOut = "Procedure" & vbTab & "Findings" & vbTab & "Priority" & vbTab & "Recommendation" & vbCr
    With ActiveDocument
      For i = 1 To .ContentControls.Count Step 4
        If .ContentControls(i + 2).Range.Text <> "N/A" Then
          StrOut = StrOut & .ContentControls(i).Range.Text & vbTab
          StrOut = StrOut & .ContentControls(i + 1).Range.Text & vbTab
          StrOut = StrOut & .ContentControls(i + 2).Range.Text & vbTab
          StrOut = StrOut & .ContentControls(i + 3).Range.Text & vbCr
        End If
      Next
    End With
    Set wdDoc = Documents.Add
    With wdDoc.Range
      .Text = StrOut
      .ConvertToTable
      With .Tables(1)
        .Rows(1).HeadingFormat = True
        .Rows(1).Range.Font.Bold = True
        .Sort ExcludeHeader:=True, FieldNumber:=3, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
      End With
    End With
    Application.ScreenUpdating = True
    End Sub
    but that's not materially shorter. It also relies on your document having no other content controls, though additional code could be used to work around that - which would make the code longer...
    Cheers
    Paul Edstein
    [MS MVP - Word]

  12. #12
    VBAX Regular
    Joined
    Aug 2018
    Posts
    10
    Location
    Quote Originally Posted by macropod View Post
    Yes, you could use code like:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim i As Long, StrOut As String, wdDoc As Document
    StrOut = "Procedure" & vbTab & "Findings" & vbTab & "Priority" & vbTab & "Recommendation" & vbCr
    With ActiveDocument
      For i = 1 To .ContentControls.Count Step 4
        If .ContentControls(i + 2).Range.Text <> "N/A" Then
          StrOut = StrOut & .ContentControls(i).Range.Text & vbTab
          StrOut = StrOut & .ContentControls(i + 1).Range.Text & vbTab
          StrOut = StrOut & .ContentControls(i + 2).Range.Text & vbTab
          StrOut = StrOut & .ContentControls(i + 3).Range.Text & vbCr
        End If
      Next
    End With
    Set wdDoc = Documents.Add
    With wdDoc.Range
      .Text = StrOut
      .ConvertToTable
      With .Tables(1)
        .Rows(1).HeadingFormat = True
        .Rows(1).Range.Font.Bold = True
        .Sort ExcludeHeader:=True, FieldNumber:=3, SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
      End With
    End With
    Application.ScreenUpdating = True
    End Sub
    but that's not materially shorter. It also relies on your document having no other content controls, though additional code could be used to work around that - which would make the code longer...
    There is always some give and take isn't there. Thank you for the additional dialogue. You are all the best!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •