VBA内の同じテキストボックス内のテキストフォントを変更する

Question

VBA内に複数のサブシステムがあり、それらのすべてがPPTスライド内の同じテキストボックス（WarningData）内に出力されています。たとえば、Sub 1はユーザー選択（GUI内のドロップダウンメニューから選択したもの）をとり、テキストボックスの最上部に挿入します。 Sub 2はその行の下に別の行のテキストを挿入します。サブ3はその下に追加テキストを挿入します。私はサブ1と2に同じフォントスタイルを持たせる必要がありますが、サブ3は異なるフォントを持つ必要があります。これがあれば

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 

任意のアイデア：

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 

次のサブ私は別のフォントスタイルを持っている必要がありますいずれかになります。ここでは

のような2外観はどのようなサブ1とサブです可能？

ありがとうございます！

Answer 1

：

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 xフォント行を追加してフォント名の設定方法を示しました。他のプロパティもFont2オブジェクトで利用可能である。 .Size、.Bold、.Fillなど、このタスクを達成するために、私はできたTextRange.Paragraphsメソッドを使用して

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