Consulting

Results 1 to 4 of 4

Thread: Toggle Red Highlight in Text boxes and in Tables

  1. #1

    Toggle Red Highlight in Text boxes and in Tables

    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

  2. #2
    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

  3. #3
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,017
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  4. #4
    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.

Posting Permissions

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