Multiple Text Fonts Within the Same Textbox

[hunter21188]

I have multiple subs within VBA that all have their output within the same text box (WarningData) in a PPT slide. For example, Sub 1 takes a user selection (a selection they made from a drop down menu within a GUI) and inserts that at the top of the text box. Sub 2 inserts another line of text below that line. Sub 3 inserts additional text below that. I need Sub 1 and 2 to have the same font style, but Sub 3 needs to have a different font. With the current code I have, all the text within the text box is the same.

Here is what Sub 1 and Sub 2 look like:



Private Sub 1()
Call Dictionary.HailInfo


ComboBoxList = Array(CStr(ComboBox3))


For Each Ky In ComboBoxList
On Error Resume Next
With ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2
'If nothing is selected in ComboBox3, do nothing and exit this sub.
If ComboBox3 = "" Then
Exit Sub
'Otherwise, if it has a selection, insert selected text.
Else
.TextRange = dict2.Item(Ky)(0)
.TextRange.Font.Size = 24
.TextRange.Font.Name = "Calibri"
.TextRange.Font.Shadow.Visible = True
.TextRange.Font.Glow.Radius = 10
.TextRange.Font.Glow.Color = RGB(128, 0, 0)
End If
End With
Next


Set dict2 = Nothing


End Sub


Private Sub 2()
Call Dictionary.WindInfo


ComboBoxList = Array(CStr(ComboBox3), CStr(ComboBox4))


For Each Ky In ComboBoxList
On Error Resume Next
With ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2
'If nothing is selected in ComboBox4, do nothing and exit this sub.
If ComboBox4 = "" Then
Exit Sub
'Otherwise, if either has a selection, insert selected text.
ElseIf ComboBox3 = "" Then
.TextRange = .TextRange & dict3.Item(Ky)(0)
.TextRange.Font.Size = 24
.TextRange.Font.Name = "Calibri"
.TextRange.Font.Shadow.Visible = True
.TextRange.Font.Glow.Radius = 10
.TextRange.Font.Glow.Color = RGB(128, 0, 0)
ElseIf ComboBox3 <> "" Then
.TextRange = .TextRange & vbCrLf & vbCrLf & dict3.Item(Ky)(0)
.TextRange.Font.Size = 24
.TextRange.Font.Name = "Calibri"
.TextRange.Font.Shadow.Visible = True
.TextRange.Font.Glow.Radius = 10
.TextRange.Font.Glow.Color = RGB(128, 0, 0)
End If
End With
Next


Set dict3 = Nothing


End Sub


Here is what sub 3 looks like:


Private Sub 3()
Call Dictionary.Call2Action


ComboBoxList = Array(CStr(ComboBox7))


For Each Ky In ComboBoxList
On Error Resume Next
With ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2
'If nothing is selected in ComboBox7 and TextBox9, do nothing and exit this sub.
If ComboBox7 = "" And TextBox9 = "" Then
Exit Sub
'Otherwise, if either has a selection, insert selected text.
ElseIf ComboBox7 <> "" And TextBox9 = "" Then
.TextRange = .TextRange & vbCrLf & vbCrLf & dict7.Item(Ky)(0)
.TextRange.Font.Size = 18
.TextRange.Font.Name = "Calibri"
.TextRange.Font.Fill.ForeColor.RGB = vbWhite
.TextRange.Font.Bold = msoTrue
ElseIf ComboBox7 = "" And TextBox9 <> "" Then
.TextRange = .TextRange & vbCrLf & vbCrLf & TextBox9
.TextRange.Font.Size = 18
.TextRange.Font.Name = "Calibri"
.TextRange.Font.Fill.ForeColor.RGB = vbWhite
.TextRange.Font.Bold = msoTrue
End If
End With
Next


Set dict7 = Nothing


End Sub

Any idea if this is possible?
Thanks!!

[hunter21188]

I was able to accomplish this by using the TextRange.Paragraphs method. I was having trouble using this method until I realized that VBA considers blank lines as their own paragraphs. Here is an example of what my final code looks like:


Private Sub 3()
Call Dictionary.Call2Action


ComboBoxList = Array(CStr(ComboBox7))


For Each Ky In ComboBoxList
On Error Resume Next
With ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2
'If nothing is selected in ComboBox7 and TextBox9, do nothing and exit this sub.
If ComboBox7 = "" And TextBox9 = "" Then
Exit Sub
'Otherwise, if either has a selection, insert selected text.
ElseIf ComboBox7 <> "" And TextBox9 = "" Then
.TextRange = .TextRange & vbCrLf & vbCrLf & dict7.Item(Ky)(0)
.TextRange.Paragraphs(3).Font.Size = 18
.TextRange.Paragraphs(3).Font.Name = "Calibri"
.TextRange.Paragraphs(3).Font.Fill.ForeColor.RGB = vbWhite
.TextRange.Paragraphs(3).Font.Bold = msoTrue
.TextRange.Paragraphs(3).Font.Glow.Transparency = 1
ElseIf ComboBox7 = "" And TextBox9 <> "" Then
.TextRange = .TextRange & vbCrLf & vbCrLf & TextBox9
.TextRange.Paragraphs(3).Font.Size = 18
.TextRange.Paragraphs(3).Font.Name = "Calibri"
.TextRange.Paragraphs(3).Font.Fill.ForeColor.RGB = vbWhite
.TextRange.Paragraphs(3).Font.Bold = msoTrue
End If
End With
Next


Set dict7 = Nothing


End Sub