PowerPoint Powerpoint - Apply Formatting To Selected Text With VBA

[allyson]

In Powerpoint 2007, I want to write a macro that applies speciifc formatting to a section of text that has been selected by the user.

I think I could work it out if I needed to format all of the text in a shape, but not just part of it.

I would use the macro recorder to work it out - but there isn't one.

(The formatting I want precisely is a round bullet point, Calibri 16 with text indented 0.5cm and hanging indent of 0.5cm - but anything to get me started with formatting a user's selected text would be most appreciated.)

 

[allyson]

I have some code that is working nicely to selected text that I have typed into a rectangle shape, but when I try to apply it to selected text that is located in a table, the indents don't behave in the same. way.

Any ideas?

Sub RevertToLevel1Formatting()
On Error Resume Next
Err.Clear
Dim oText As TextRange
'Require the users to select some text
Set oText = ActiveWindow.Selection.TextRange
If Err.Number <> 0 Then
MsgBox "Invalid Selection. Please highlight some text " _
& "or select a text frame and run the macro again.", vbExclamation
End
End If
'Display the selected text in a message box
If oText.Text = "" Then
MsgBox "No Text Selected.", vbInformation
Else
MsgBox oText, vbInformation
End If

With oText
.IndentLevel = 1
.ParagraphFormat.Alignment = ppAlignLeft
With .Parent.Ruler
.Levels(1).FirstMargin = 0
.Levels(1).LeftMargin = 0
.Levels(2).FirstMargin = 0
.Levels(2).LeftMargin = 28.3465
.Levels(3).FirstMargin = 28.3465
.Levels(3).LeftMargin = 56.6929
End With
.ParagraphFormat.Bullet.Visible = msoFalse
With .Font
.Name = "Calibri"
.Bold = msoFalse
.Color.RGB = RGB(0, 0, 0)
.Size = 14
End With
End With
End Sub
Sub ApplyLevel2Formatting()
On Error Resume Next
Err.Clear
Dim oText As TextRange
'Require the users to select some text
Set oText = ActiveWindow.Selection.TextRange
If Err.Number <> 0 Then
MsgBox "Invalid Selection. Please highlight some text " _
& "or select a text frame and run the macro again.", vbExclamation
End
End If
'Display the selected text in a message box
If oText.Text = "" Then
MsgBox "No Text Selected.", vbInformation
Else
MsgBox oText, vbInformation
End If

With oText
.ParagraphFormat.Alignment = ppAlignLeft
.IndentLevel = 2
With .Parent.Ruler
.Levels(1).FirstMargin = 0
.Levels(1).LeftMargin = 0
.Levels(2).FirstMargin = 0
.Levels(2).LeftMargin = 28.3465
.Levels(3).FirstMargin = 28.3465
.Levels(3).LeftMargin = 56.6929
End With
With .ParagraphFormat.Bullet
.Visible = msoCTrue
.RelativeSize = 1
.Character = 159
With .Font
.Color.RGB = RGB(0, 0, 0)
.Name = "Wingdings"
End With
End With
With .Font
.Name = "Calibri"
.Bold = msoFalse
.Color.RGB = RGB(0, 0, 0)
.Size = 14
End With
End With

End Sub
Sub ApplyLevel3Formatting()
On Error Resume Next
Err.Clear
Dim oText As TextRange
'Require the users to select some text
Set oText = ActiveWindow.Selection.TextRange
If Err.Number <> 0 Then
MsgBox "Invalid Selection. Please highlight some text " _
& "or select a text frame and run the macro again.", vbExclamation
End
End If
'Display the selected text in a message box
If oText.Text = "" Then
MsgBox "No Text Selected.", vbInformation
Else
MsgBox oText, vbInformation
End If

With oText
.ParagraphFormat.Alignment = ppAlignLeft
.IndentLevel = 3
With .Parent.Ruler
.Levels(1).FirstMargin = 0
.Levels(1).LeftMargin = 0
.Levels(2).FirstMargin = 0
.Levels(2).LeftMargin = 28.3465
.Levels(3).FirstMargin = 28.3465
.Levels(3).LeftMargin = 56.6929
End With
With .ParagraphFormat.Bullet
.Visible = msoCTrue
.RelativeSize = 1
.Character = 173
With .Font
.Color.RGB = RGB(0, 0, 0)
.Name = "Calibri"
End With
End With
With .Font
.Name = "Calibri"
.Bold = msoFalse
.Color.RGB = RGB(0, 0, 0)
.Size = 14
End With
End With

End Sub