Toggle Red Highlight in Text boxes and in Tables

[bcummins77]

Hi all,

I have created the following macro to toggle on/off red highlight for selected text whether in a text box or table. For the table there doesn't have to be text for it to toggle the highlight.
However, when in a table and I toggle the highlight off, on the slide I am on, the highlight toggles off, but in the slide layout and on the slide show (if running) the highlight remains. Is there something I am missing to force the highlight to toggle off?

Sub highlghtred()
Dim oShp As Shape
Dim oTbl As Table
Dim oTxtFrame As TextFrame
If ActiveWindow.Selection.Type = ppSelectionText Then
    If Not ActiveWindow.Selection.TextRange.Parent Is Nothing Then
        Set oTxtFrame = ActiveWindow.Selection.TextRange.Parent
        Set oShp = oTxtFrame.Parent
        Call ToggleShapeHighlight(oShp)
    End If
End If
If ActiveWindow.Selection.Type = ppSelectionShapes Then
    If ActiveWindow.Selection.HasChildShapeRange Then
        Call ToggleHighlight(ActiveWindow.Selection.ChildShapeRange)
    Else
       Call ToggleHighlight(ActiveWindow.Selection.ShapeRange)
    End If
Else
    If ActiveWindow.Selection.Type <> ppSelectionNone Then
        If ActiveWindow.Selection.ShapeRange.HasTable Then
            For Each oShp In ActiveWindow.Selection.ShapeRange
                If oShp.Type = msoTable Then
                    Call ToggleTableHighlight(oShp.Table)
                End If
            Next oShp
        End If
    End If
End If
    
End Sub

Sub ToggleHighlight(oShpRng As ShapeRange)
Dim shp As Shape
Dim ActiveShape As Shape
For Each shp In oShpRng
     Set ActiveShape = shp
     'MsgBox ("Shape color is currently " & shp.Fill.BackColor.RGB)
     If ActiveShape.HasTextFrame Then
        'MsgBox ("Found text " + ActiveShape.TextFrame.TextRange.Text)
         If ActiveShape.TextFrame.TextRange.Text <> "" Then
            Call ToggleShapeHighlight(ActiveShape)
         End If
      Else
      If ActiveShape.Type = msoTable Then
         Call ToggleTableHighlight(ActiveShape.Table)
      End If
  End If
Next shp
End Sub

Sub ToggleTableHighlight(oTbl As Table)
Dim x As Long
Dim y As Long
With oTbl
    For x = 1 To .Rows.Count
        For y = 1 To .Columns.Count
            If .Cell(x, y).Selected Then
                If .Cell(x, y).Shape.Fill.Visible = msoFalse Then
                    .Cell(x, y).Shape.Fill.ForeColor.RGB = RGB(255, 0, 0)
                    .Cell(x, y).Shape.Fill.Solid
                Else
                    .Cell(x, y).Shape.Fill.Visible = msoFalse
                End If
            End If
        Next y
    Next x
End With
End Sub

Sub ToggleShapeHighlight(oShp As Shape)
    If oShp.Fill.Visible = msoFalse Then
        oShp.Fill.ForeColor.RGB = RGB(255, 0, 0)
        oShp.Fill.Solid
        oShp.Fill.Visible = msoTrue
    Else
        oShp.Fill.Visible = msoFalse
    End If
End Sub

[bcummins77]

I have managed to get this to work by assigning the contents of the cell to a string and then putting them back in the cell - it's inelegant but it works - I'm hoping someone might be able to assist with a better solution though.

Sub ToggleTableHighlight(oTbl As Table)
Dim x As Long
Dim y As Long
Dim strCell As String
With oTbl
    For x = 1 To .Rows.Count
        For y = 1 To .Columns.Count
            If .Cell(x, y).Selected Then
                If .Cell(x, y).Shape.Fill.Visible = msoFalse Then
                    .Cell(x, y).Shape.Fill.Visible = msoTrue
                    .Cell(x, y).Shape.Fill.Solid
                    .Cell(x, y).Shape.Fill.ForeColor.RGB = RGB(255, 0, 0)
                Else
                    .Cell(x, y).Shape.Fill.Visible = msoFalse
                    strCell = .Cell(x, y).Shape.TextFrame.TextRange.Text
                    .Cell(x, y).Shape.TextFrame.TextRange.Text = strCell
                End If
            End If
        Next y
    Next x
End With
End Sub

[John Wilson]

I'm not sure there is a much better solution. Some changes do not seem to kick the thumbnail view to update. Usually i add a move left one point followed by a move right one point to give it a kick. Not exactly scientific but it seems to work.

 Else
.Cell(x, y).Shape.Fill.Visible = msoFalse
.Parent.Left=.Parent.Left-1
.parent.Left=.Parent.Left+1

[bcummins77]

Thanks for replying John, I was hoping you would, I've seen many of your posts and they are usually spot on.
I was hoping there was one line of code that could do some kind of screen or presentation refresh, but I'll use what works.