1

I'm trying to create a macro that sets the font colour of text in a cell to white and the cell background to black using VBA in Publisher.

So far I have managed to set up the font colour to change but I'm really struggling with the background - I can't find the right value to change.

Here's what I have so far:

Sub set_to_clue()

Selection.TextRange.Font.Color.RGB = RGB(255, 255, 255)
Selection.TextRange.Font.Fill.BackColor.RGB = RGB(0, 0, 0)

End Sub

Progress With a bit of further trial and error I have worked out how to get cell backgrounds to change, however currently I can only do it by specifying an item number for the CellRange. This means that the cell that changes colour is hard coded rather than the selected one. How can I calculate the item number?

Sub set_to_clue()

Selection.TextRange.Font.Color.RGB = RGB(255, 255, 255)
Selection.TableCellRange.Item(10).Fill.ForeColor.RGB = RGB(0, 255, 0)

End Sub
Rory
  • 2,175
  • 1
  • 27
  • 37

2 Answers2

0

I now have a working version, though I am sure it is not the correct or most elegant way to achieve the goal.

It also currently only works if the cell itself is entirely highlighted rather than just the text within it or just the cursor being in the cell. I may work to improve this later.

Working code in Publisher 2016:

Sub invert_square()

For Each square In Selection.TableCellRange
    If square.Selected = True Then
        square.Fill.ForeColor.RGB = RGB(0, 0, 0)
        square.TextRange.Font.Color.RGB = RGB(255, 255, 255)
        Exit For
    End If
    Next

End Sub
Rory
  • 2,175
  • 1
  • 27
  • 37
0

This expands your code so that it works for the entire table if the table as a whole is selected (selection type pbSelectionShape and shape type pbTable) and for the entire cell if the selection is of type pbSelectionText.

The trick for the latter functionality is that the .ContainingObject refers to the entire Shape, and that every Table Shape consists of one Story object. The .Start and .End properties of a TextRange object refer to its position within it's Story object. By comparing these two properties, we are able to identify which cell the selected text belongs to (it is not possible in Publisher to simultaneously select a little bit of text in several different cells).

Before I figured out this approach, I tried to call .Parent until TypeName() would equal "Cell", but this wouldn't work because the .Parent for Selection.TextRange is Selection (and not the Parent in the document itself as I had hoped)

Option Explicit

Sub InvertSquare()
    ActiveDocument.BeginCustomUndoAction "Invert square"

    Dim oCell As Cell
    Dim oShape As Shape

    If selection.Type = pbSelectionTableCells Then
        Debug.Print "Table cells"

        For Each oCell In selection.TableCellRange
            SetInvertedColors oCell
        Next oCell

    ElseIf selection.Type = pbSelectionText Then
        Debug.Print "Text"

        Dim selText As TextRange
        Dim x As Variant

        Set selText = selection.TextRange
        Set x = selText.ContainingObject

        If TypeName(x) = "Shape" Then
            If x.Type = pbTable Then
                For Each oCell In x.Table.Cells
                    If oCell.HasText Then
                        If oCell.TextRange.Start <= selText.Start Then
                            If oCell.TextRange.End >= selText.End Then
                                SetInvertedColors oCell
                                Exit For
                            End If
                        End If
                    End If

                Next oCell
            End If
        End If

    ElseIf selection.Type = pbSelectionShape Then
        Debug.Print "ShapeRange"

        Dim oShapes As ShapeRange

        Set oShapes = selection.ShapeRange
        For Each oShape In oShapes
            If oShape.Type = pbTable Then
                For Each oCell In selection.TableCellRange
                    SetInvertedColors oCell
                Next oCell
                Exit For
            End If
        Next oShape
        Debug.Print "Shape"
    End If

    ActiveDocument.BeginCustomUndoAction "Invert square"
End Sub


Sub SetInvertedColors(oCell As Cell)
    Debug.Print oCell.TextRange.Text
    oCell.TextRange.Font.Color = RGB(255, 255, 255)
    ''oCell.Fill.ForeColor.RGB = RGB(0, 0, 0) ''Out of memory error for whatever reason
End Sub

For some reason, I get an out of memory error when I try to set the .ForeColor.RGB in Publisher, but this happens with your code for me too, so I'm hoping that it works for you anyway if you uncomment the second last line.

Jbjstam
  • 874
  • 6
  • 13