Using VBA to Change Text Outline Color

[hermit14_geo]

Hi! I'm trying to write VBA code in PowerPoint to change the outline color of a particular font called "Wingding". I have a table where I want to be able to automatically add a row to the end of the table (got that part to work), then based on the user's selection, add a particular Wingding to a particular cell in the table. Then also based on the user's selection, I need to be able to change both the fill and the outline color of the Wingding through VBA code. I tried recording a macro, but it displayed nothing. I know that I can change the colors of the Wingding manually, but I need to be able to do it through VBA. Anyone have any ideas how to do this? Everything I ty keeps producing an error and I'm getting really frustrated with this. Changing the Wingding's outline color is the last bit of code that I need for my project. Any help on this would be greatly appreciated. Thanks!!

[John Wilson]

You need to say which version of PowerPoint.

[hermit14_geo]

Sorry. I'm new to this. I'm working in PowerPoint 2007.

[John Wilson]

I guessed that. You need to use the TextFrame2 object but in 2007 it#s not fully implemented.

I'm guessing you have the text selected??

In 2010 you can say

Dim oTxr2 as Textrange2
Set oTxr2=ActiveWindow.Selection.TextRange2
oTxr2.Font.Line.Forecolor.RGB=RGB(255,0,0)

This doesn't work in 2007

One way:


Sub workAround()
Dim otxr As TextRange
Dim otxr2 As TextRange2
Dim oshp As Shape
Set otxr = ActiveWindow.Selection.TextRange
Set oshp = otxr.Parent.Parent
Set otxr2 = oshp.TextFrame2.TextRange.Characters(otxr.Start, otxr.Length)
With otxr2.Font.Line
.Visible = True
.ForeColor.RGB = vbRed
.Weight = 2
End With
End Sub

[hermit14_geo]

I am not selecting the text. Here is the code I am using now:



With ActivePresentation
Set myTable = .Slides(1).Shapes(1).Table
myTable.Rows.Add
myTable.Columns(1).Cells(myTable.Columns(1).Cells.Count).Shape.TextFrame.Te xtRange.Text = "MCCTS"
myTable.Columns(2).Cells(myTable.Columns(2).Cells.Count).Shape.TextFrame.Te xtRange.Text = "III"
myTable.Columns(3).Cells(myTable.Columns(3).Cells.Count).Shape.TextFrame.Te xtRange.Text = "FMR"
myTable.Columns(4).Cells(myTable.Columns(4).Cells.Count).Shape.TextFrame.Te xtRange.InsertSymbol FontName:="Wingdings", CharNumber:=108
myTable.Columns(4).Cells(myTable.Columns(4).Cells.Count).Shape.TextFrame.Te xtRange.Font.Size = 12
myTable.Columns(4).Cells(myTable.Columns(4).Cells.Count).Shape.TextFrame.Te xtRange.Font.Color = RGB(180, 36, 12)
myTable.Columns(4).Cells(myTable.Columns(4).Cells.Count).Shape.TextFrame.Te xtRange.Font.Line.ForeColor = RGB(255, 0, 0)
End With

I get an error message on the last myTable... line. I need to be able to change the boundary color of the Wingding. This is only an example of one cell where I need to change the boundary color. I need to change it numerous times in my code. I just wrote the above code to test it out. Any help that could be provided would be appreciated. Thanks!!

[John Wilson]

Interesting!

This code should work and doesn't error but also doesn't work!!


Sub fixMytable()
Dim myTable As Table
Dim otxr As TextRange2
Set myTable = ActivePresentation.Slides(1).Shapes(1).Table
With myTable
.Rows.Add
.Cell(.Rows.Count, 1).Shape.TextFrame2.TextRange.Text = "MCCTS"
.Cell(.Rows.Count, 2).Shape.TextFrame2.TextRange.Text = "III"
.Cell(.Rows.Count, 3).Shape.TextFrame2.TextRange.Text = "FMR"
.Cell(.Rows.Count, 4).Shape.TextFrame2.TextRange.InsertSymbol FontName:="Wingdings", CharNumber:=108
Set otxr = .Cell(.Rows.Count, 4).Shape.TextFrame2.TextRange
With otxr.Font
.Fill.ForeColor.RGB = RGB(180, 36, 12)
.Size = 12
.Line.Visible = True
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Line.Weight = 2
End With
End With
End Sub

I think it's a bug in the Table Object model!

The only way I could get it to work in code was to create the text outside the table and paste in in.



Sub fixMytable2()
Dim myTable As Table
Dim otxr As TextRange2
Dim osld As Slide
Set osld = ActivePresentation.Slides(1)
Set myTable = ActivePresentation.Slides(1).Shapes(1).Table
With myTable
.Rows.Add
.Cell(.Rows.Count, 1).Shape.TextFrame2.TextRange.Text = "MCCTS"
.Cell(.Rows.Count, 2).Shape.TextFrame2.TextRange.Text = "III"
.Cell(.Rows.Count, 3).Shape.TextFrame2.TextRange.Text = "FMR"
With osld.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 20, 20)
Set otxr = .TextFrame2.TextRange
With otxr
.InsertSymbol FontName:="Wingdings", CharNumber:=108
.Font.Fill.ForeColor.RGB = RGB(180, 36, 12)
.Font.Size = 12
.Font.Line.Visible = True
.Font.Line.ForeColor.RGB = RGB(255, 0, 0)
.Font.Line.Weight = 1
.Copy
.Delete
End With 'textrange
End With 'Added box
.Cell(.Rows.Count, 4).Shape.TextFrame2.TextRange.Paste
End With
End Sub

[hermit14_geo]

John Wilson,

Thanks for all of your help. The second batch of code that you provided (doing the copy and paste) worked for me. I was able to complete my programming. Now all I have to do is get the code to place nice with SharePoint!