为什么TextRange.InsertSymbol方法替换了我的TextRange中的文本?

时间:2019-06-06 19:21:55

标签: vba powerpoint-vba powerpoint-2010

在PowerPoint中通过VBA生成幻灯片的过程中,我需要在生成的文本中插入“ Wingdings符号”,该文本是两个值的比较。我做了这种方法,完全可以按照我的意愿

Sub formatDifference(header As String, old As Integer, now As Integer, txt As TextRange)
    Dim diff As Integer
    diff = old - now

    With txt
        If (diff > 0) Then
            .InsertSymbol "Wingdings", getArrowCharCode("down")
                                       ' getArrowCharCode is a custom function to get the 
                                       ' char code as an Integer
        ElseIf (diff = 0) Then
            .InsertSymbol "Wingdings", getArrowCharCode("right")
        Else
            .InsertSymbol "Wingdings", getArrowCharCode("up")
        End If

        .InsertBefore header & now & " ("    ' <-- note this line
        .InsertAfter " " & Abs(diff) & ")"
    End With
End Sub

formatDifference Sub基本上只是在文本中添加一个项目符号点线(在下面的示例中,在添加非项目符号文本之前,该过程被调用了4次)。

我不明白的是,当我用一些文本初始化文本然后使用InsertSymbol方法时,文本似乎实际上已被替换,而不是在末尾附加符号。这是不同代码的示例:

Sub formatDifference(header As String, old As Integer, now As Integer, txt As TextRange)
    Dim diff As Integer
    diff = old - now

    With txt
        .InsertAfter header & now & " (" ' <-- line moved here
                                         '     it doesn't matter if I use 
                                         '     .Text = "initial text"', 
                                         '     it will do the same thing
        If (diff > 0) Then
            .InsertSymbol "Wingdings", getArrowCharCode("down")
        ElseIf (diff = 0) Then
            .InsertSymbol "Wingdings", getArrowCharCode("right")
        Else
            .InsertSymbol "Wingdings", getArrowCharCode("up")
        End If
        .InsertAfter " " & Abs(diff) & ")"
    End With
End Sub

这是我从上面的代码(以相同的顺序)得到的两个结果的比较:

Example of the difference the codes make

我对InsertSymbol方法的理解是,它会在最后一段的末尾插入符号,但看起来并不像...第二个示例是否错误或我误解了{{ 3}}?


P.S。注意:标头参数包含回车符和换行符,这就是为什么第二次捕获在同一行上具有所有点的原因,因为似乎替换了第一部分。

2 个答案:

答案 0 :(得分:1)

我可以做出一种似乎很好的解决方法。

Sub AppendSymbol(ByRef orig As TextRange, ByVal fontName As String, ByVal charCode As Integer, Optional ByVal position As Integer = -1)
    Dim strStart, strEnd As String

    If ((position < 0) Or (position >= Len(orig.text))) Then
        orig.Paragraphs(orig.Paragraphs.Count + 1).InsertSymbol fontName, charCode
        'this one just inserts the symbol at the end by forcing a new paragraph
    Else
        strStart = Left(orig.text, position)
        strEnd = Right(orig.text, Len(orig.text) - position)

        orig.Paragraphs(1).InsertSymbol fontName, charCode
        orig.InsertBefore strStart
        orig.InsertAfter strEnd
    End If
End Function

在该子例程中,我基本上复制了原始行,将其替换为符号,然后在符号周围重新添加了字符串。

我现在可以这样称呼该Sub:

Private Sub displayTotal(ByRef para As TextRange, ByVal prevCompare As Testing)
    Dim arrowDirection As String
    Dim tempDifference As Integer

    tempDifference = p_total - prevCompare.Total
    para.InsertAfter "Number of elements : " & p_total & " ("

    'calling the Sub
    AppendSymbol para, "Wingdings", getWingdingArrowChar(getArrowDirection(tempDifference))

    para.InsertAfter " " & Abs(tempDifference) & ")"
    para.IndentLevel = 2
    para.ParagraphFormat.Bullet = msoFalse
End Sub

至于解释,Asger似乎有些不足。该方法的实现显然类似于Word的实现,在添加符号之前需要折叠文本范围。

在上面的自定义方法中,行orig.Paragraphs(orig.Paragraphs.Count + 1).InsertSymbol fontName, charCode基本上是通过在当前段落之后添加一个段落来强制折叠当前段落,这就是InsertSybol方法随后可以按预期工作的原因。

答案 1 :(得分:1)

InsertSymbol实现的文档

Microsoft Word的Range.InsertSymbolSelection.InsertSymbol实现描述为:

  

在指定范围内插入符号。
  如果您不想替换范围,请在使用此方法之前先使用“折叠”方法。

Microsoft Publisher的TextRange.InsertSymbol实现描述为:

  

返回一个TextRange对象,该对象表示在指定范围或选择位置插入的符号。
  如果您不想替换范围或选择,请在使用此方法之前使用“折叠”方法。

然后有Office TextRange2.InsertSymbol和PowerPoint TextRange2.InsertSymbol方法,描述如下:

  

将指定字体集中的符号插入到TextRange2对象表示的文本范围内。

请牢记,TextRange.InsertSymbol实现的PowerPoint文档有些不准确,其中包括以下内容的错误解释(“第一句话之后”)随附的代码示例。

在文本范围后的

如果要在提供的TextRange之后插入符号,建议使用以下包装函数:

Public Function InsertSymbolAfter(newTextRange As PowerPoint.TextRange, _
                           newFontName As String, _
                           newCharNumber As Long, _
                           Optional newUnicode As MsoTriState = msoFalse) As TextRange

    If Right(newTextRange.Text, 1) = vbCr Then
        Set InsertSymbolAfter = newTextRange.Characters(newTextRange.Characters.Count) _
            .InsertSymbol(newFontName, newCharNumber, newUnicode)
        newTextRange.InsertAfter vbCr
    Else
        Set newTextRange = newTextRange.InsertAfter("#")
        Set InsertSymbolAfter = newTextRange _
            .InsertSymbol(newFontName, newCharNumber, newUnicode)
    End If

End Function

它区分两种情况:

  • 如果最后一个字符是vbCRChr(13),回车符,CR),则在CR之前添加符号(CR用新符号代替,然后再添加)。
  • 在所有其他情况下,会先添加一个任意字符,然后将其替换为新符号。

测试

可以通过以下方法对整个文本框,段落或字符进行测试:

Private Sub testit()
    Const WingDingsLeft As Long = 231
    Const WingDingsRight As Long = 232
    Const WingDingsUp As Long = 233
    Const WingDingsDown As Long = 234

    With ActivePresentation.Slides(1).Shapes(1).TextFrame
        InsertSymbolAfter(.TextRange, "Wingdings", WingDingsUp)
        InsertSymbolAfter(.TextRange.Paragraphs(1), "Wingdings", WingDingsDown)
        InsertSymbolAfter(.TextRange.Characters(2, 1), "Wingdings", WingDingsRight)
    End With
End Sub