更改VBA中相同文本框中的文本字體

Question

我在VBA中有多個子文件，它們都在PPT幻燈片中的相同文本框（WarningData）內具有其輸出。例如，Sub 1接受用戶選擇（他們從GUI中的下拉菜單中進行選擇）並將其插入到文本框的頂部。子2在該行下面插入另一行文本。小組3在下面插入其他文字。我需要Sub 1和Sub 2具有相同的字體樣式，但Sub 3需要使用不同的字體。

這裏是分1分2的樣子：

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 

以下子是我需要有一個不同的字體樣式的一個：

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 

任何想法，如果這是可能？

謝謝！

Answer 1

使用TextRange.Paragraphs方法，我能夠完成這個任務：

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

我使用With語句簡化了代碼，並添加了2個字體行來顯示如何設置字體名稱。 Font2對象中還有其他屬性，例如.Size，.Bold，等.fill僞

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