Loop through ContentControls by Tag and color cells depending on text

[Cubajz]

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.

[macropod]

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

[Cubajz]

Thank you very much! Both are great:hi: