在 VBA 中的同一文本框中更改文本字体

Question

我在 VBA 中有多个 subs，它们的输出都在 PPT 幻灯片的同一个文本框 (WarningData) 中。例如，Sub 1 获取用户选择（他们从 GUI 中的下拉菜单中做出的选择）并将其插入到文本框的顶部。 Sub 2 在该行下方插入另一行文本。 Sub 3 在其下方插入附加文本。我需要 Sub 1 和 2 具有相同的字体样式，但 Sub 3 需要具有不同的字体。

这是 Sub 1 和 Sub 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

我使用 With 语句简化了代码并添加了 2 x 字体行来展示如何设置字体名称。 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

Answer 2

使用 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

在 VBA 中的同一文本框中更改文本字体

Change Text Font within Same Textbox in VBA

powerpoint

vba