Ändern Sie Schriftart in demselben Textfeld in VBA

Question

Ich habe mehrere Subs in VBA, die alle ihre Ausgabe innerhalb desselben Textfelds (WarningData) in einer PPT-Folie haben. Zum Beispiel nimmt Sub 1 eine Benutzerauswahl (eine Auswahl, die sie aus einem Dropdown-Menü innerhalb einer GUI getroffen haben) und fügt diese oben in das Textfeld ein. Unter 2 fügt eine weitere Textzeile unterhalb dieser Zeile ein. Unter 3 fügt zusätzlichen Text darunter ein. Ich brauche Sub 1 und 2, um den gleichen Schriftstil zu haben, aber Sub 3 muss eine andere Schriftart haben. Hier

ist, was Sub 1 und Sub 2 wie folgt aussehen:

Private Sub 1() 'Sub 2 is very similar. 
Call Dictionary.WindInfo 

    'Sets the font for the warning information text. 

    With ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange.Font 

    .Size = 24 
    .Name = "Calibri" 
    .Bold = msoTrue 
    .Shadow.Visible = True 
    .Glow.Radius = 10 
    .Glow.Color = RGB(128, 0, 0) 

    End With 

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

    For Each Ky In ComboBoxList 

    On Error Resume Next 
    'If nothing is selected in ComboBox4, do nothing and exit this sub. 
    If ComboBox4 = "" Then 
    Exit Sub 
    ElseIf ComboBox3 = "" Then 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange = _ 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange & dict3.Item(Ky)(0) 
    'Otherwise, if it has a selection, insert selected text. 
    ElseIf ComboBox3 <> "" Then 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange = _ 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange & vbCrLf & vbCrLf & dict3.Item(Ky)(0) 

    End If 

Next 

Set dict3 = Nothing 

End Sub 

Die folgenden Unter ist derjenige, ich brauche einen anderen Schriftstil haben:

Private Sub 3() 
Call Dictionary.Call2Action 

ComboBoxList = Array(CStr(ComboBox7)) 

    For Each Ky In ComboBoxList 

    On Error Resume Next 
    '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 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange = _ 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange & vbCrLf & vbCrLf & dict7.Item(Ky)(0) 
    ElseIf ComboBox7 = "" And TextBox9 <> "" Then 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange = _ 
    ActiveWindow.Selection.SlideRange.Shapes("WarningData").TextFrame2.TextRange & vbCrLf & vbCrLf & TextBox9 

    End If 

Next 

Set dict7 = Nothing 

End Sub 

Jede Idee, wenn dies möglich?

Danke !!

Answer 1

die TextRange.Paragraphs Methode verwenden ich in der Lage war, diese Aufgabe zu erfüllen:

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 

Answer 2

Ich vereinfachte den Code mit einer With-Anweisung und fügte 2 x Font-Zeilen hinzu, um zu zeigen, wie man den Font-Namen einstellt. Andere Eigenschaften sind auch im Font2-Objekt verfügbar, z. .Size, .Bold, .Fill usw.

Private Sub Three() 
    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.Name = "Calibri" 
     ElseIf ComboBox7 = "" And TextBox9 <> "" Then 
     .TextRange = .TextRange & vbCrLf & vbCrLf & TextBox9 
     .TextRange.Font.Name = "Calibri" 
     End If 
    End With 
    Next 

    Set dict7 = Nothing 

End Sub