Consulting

Results 1 to 3 of 3

Thread: Loop through ContentControls by Tag and color cells depending on text

  1. #1
    VBAX Regular
    Joined
    May 2015
    Posts
    28
    Location

    Loop through ContentControls by Tag and color cells depending on text

    Hi,
    I was wondering if this code could be made into simple loop (there is 300 of prepared tagged CC boxes in document with tags: "1","2","3","4" etc...continuing to "300").
    My original code just selects CC by tag and then colors table cell in which cc is located. Color is chosen depending on text of curent CC.

    Dim BOX As ContentControl
    
    
    Set BOX = ActiveDocument.SelectContentControlsByTag("1").Item(1) 'TAG #
    If BOX.Range = "NEDODÁNO" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = 5263615
    End If
    If BOX.Range = "DODÁNO" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = -704577537
    End If
    If BOX.Range = "SKOPAL" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = -704577537
    End If
    If BOX.Range = "VYBER" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = wdColorBlack
    End If
    
    
    
    
    Set BOX = ActiveDocument.SelectContentControlsByTag("2").Item(1) 'TAG #
    If BOX.Range = "NEDODÁNO" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = 5263615
    End If
    If BOX.Range = "DODÁNO" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = -704577537
    End If
    If BOX.Range = "SKOPAL" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = -704577537
    End If
    If BOX.Range = "VYBER" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = wdColorBlack
    End If
    
    
    
    
    Set BOX = ActiveDocument.SelectContentControlsByTag("3").Item(1) 'TAG #
    If BOX.Range = "NEDODÁNO" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = 5263615
    End If
    If BOX.Range = "DODÁNO" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = -704577537
    End If
    If BOX.Range = "SKOPAL" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = -704577537
    End If
    If BOX.Range = "VYBER" Then
       BOX.Range.Cells(1).Shading.BackgroundPatternColor = wdColorBlack
    End If



    Can this be looped? Appriciate any help, editing this code for 300+ tags is timeconsuming. Thanks for help in advance.


  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,124
    Location
    For example:
    For Each CCtrl In ActiveDocument.ContentControls
      With CCtrl
        If IsNumeric(.Tag) Then
          Select Case .Range.Text
            Case "NEDODÁNO": .Range.Cells(1).Shading.BackgroundPatternColor = 5263615
            Case "DODÁNO": .Range.Cells(1).Shading.BackgroundPatternColor = -704577537
            Case "SKOPAL": .Range.Cells(1).Shading.BackgroundPatternColor = -704577537
            Case "VYBER": .Range.Cells(1).Shading.BackgroundPatternColor = wdColorBlack
          End Select
        End If
      End With
    Next
    Conversely, if you're using a ContentControlOnExit macro to update the current cell, you could use:
    Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
    Application.ScreenUpdating = False
    With CCtrl
      If IsNumeric(.Tag) Then
        Select Case .Range.Text
          Case "NEDODÁNO": .Range.Cells(1).Shading.BackgroundPatternColor = 5263615
          Case "DODÁNO": .Range.Cells(1).Shading.BackgroundPatternColor = -704577537
          Case "SKOPAL": .Range.Cells(1).Shading.BackgroundPatternColor = -704577537
          Case "VYBER": .Range.Cells(1).Shading.BackgroundPatternColor = wdColorBlack
        End Select
      End If
    End With
    Application.ScreenUpdating = True
    End Sub
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    VBAX Regular
    Joined
    May 2015
    Posts
    28
    Location
    Thank you very much! Both are great

Posting Permissions

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