Question

我在VBA中有多个sub，它们的输出都在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个字体行来显示如何设置字体名称。 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中更改相同文本框中的文本字体

2 个答案: