在不覆盖 VBA 中的现有文本的情况下将文本附加到形状

Question

我在 VBA 中有一个脚本，可以将某些用户选择的变量打印到 PPT 模板中。在此子中：

Private Sub WarningInfo()
Call Dictionary.WarningInfo

  'Sets the font for the warning information text.

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

    .Size = 24
    .Name = "Calibri"
    .Shadow.Visible = True

   End With

ComboBoxList = Array(CStr(ComboBox3))

   For Each Ky In ComboBoxList

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

    End If

 Next

Set dict2 = Nothing

End Sub

它会在 WarningText1 形状内打印出 dict2.Item(Ky)(0)。该变量由用户在 GUI 中选择，并从字典中提取。选择和输出内容的示例是 "No hail expected".

我的下一篇是这样的：

Private Sub WarningInfo2()
Call Dictionary.WindInfo

  'Sets the font for the warning information text.

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

    .Size = 24
    .Name = "Calibri"
    .Shadow.Visible = True

   End With

ComboBoxList = Array(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
    'Otherwise, if it has a selection, insert selected text.
    Else
     ActiveWindow.Selection.SlideRange.Shapes("WarningText1").TextFrame2.TextRange = vbCrLf & dict3.Item(Ky)(0)

    End If

 Next

Set dict3 = Nothing

End Sub

它会打印出dict3.Item(Ky)(0)。但是，根据第二个子项的设置方式，它只会覆盖第一个子项的数据（因为两个子项都在同一个用户窗体中）。我需要找到一种方法来更改这行代码 ActiveWindow.Selection.SlideRange.Shapes("WarningText1").TextFrame2.TextRange = vbCrLf & dict3.Item(Ky)(0)，以便将此文本添加到形状 "WarningText1".

内的现有文本中

有什么想法吗？

谢谢！！

Answer 1

ActiveWindow.Selection.SlideRange.Shapes("WarningText1").TextFrame2.TextRange = ActiveWindow.Selection.SlideRange.Shapes("WarningText1").TextFrame2.TextRange & vBCrLf & dict3.Item (基) (0)

在不覆盖 VBA 中的现有文本的情况下将文本附加到形状

Append Text to Shape Without Overwriting Existing Text in VBA

powerpoint

vba