Question

我需要做的是找到一个向上箭头字符并用向上箭头形状替换它并为向下的arros做同样的事情。我是VBA的新手，但对于我希望宏如何工作有一个想法。它应该遍历powerpoint上的所有幻灯片。

1）找到箭头角色的位置？（使用INSTR命令？和CHR代码命令。不确定INSTR是否在ppt中工作或者是否是适当的代码）

2）使用从上一行代码返回的位置添加形状。我的代码在下面，已经将此形状添加到我的规格中。

  Dim i As Integer
  Dim shp As Shape
  Dim sld As Slide
  Set sld = Application.ActiveWindow.View.Slide

  Set shp = sld.Shapes.AddShape(36, 10, 10, 5.0399, 8.6399)
  shp.Fill.ForeColor.RGB = RGB(89, 0, 0)
   shp.Fill.BackColor.RGB = RGB(89, 0, 0)
 shp.Line.ForeColor.RGB = RGB(89, 0, 0)

3）查找并删除所有字符箭头，使形状成为唯一留下的形状。

我在PPT中一直在努力通过VBA，并感谢你能给我的任何帮助。

Answer 1

你走在正确的轨道上。假设我有一个这样的形状，它有字母和特殊字符，由十六进制值&H25B2表示。

enter image description here

首先，您需要确定角色的价值。有很多地方可以找到这些参考文献。

然后，如何在你的代码中使用，这是一个找到形状的例子，并用你的箭头覆盖它，根据@ SteveRindsberg的建议进行修改，如下：）

Public Const upArrow As String = &H25B2     'This is the Hex code for the upward triangle/arrow
Public Const downArrow As String = &H25BC   'This is the Hex code for the downward triangle/arrow
Sub WorkWithSpecialChars()
    Dim pres As Presentation
    Dim sld As Slide
    Dim shp As Shape
    Dim foundAt As Long
    Dim arrowTop As Double
    Dim arrowLeft As Double
    Dim arrow As Shape
    Set pres = ActivePresentation

    For Each sld In pres.Slides
       For Each shp In sld.Shapes
        If shp.HasTextFrame Then
           foundAt = InStr(shp.TextFrame.TextRange.Characters.Text, ChrW(upArrow))
           If foundAt > 0 Then
               MsgBox "Slide " & sld.SlideIndex & " Shape " & shp.Name & " contains " & _
                   "the character at position " & foundAt, vbInformation

                'Select the text
                With shp.TextFrame.TextRange.Characters(foundAt, 1)
                'Get the position of the selected text & add the arrow
                    Set arrow = sld.Shapes.AddShape(36, _
                            .BoundLeft, .BoundTop, .BoundWidth, .BoundHeight)
                    'additional code to format the shape
                    ' or call a subroutine to format the shape, etc.


                End With
           Else:
               Debug.Print "Not found in shape " & shp.Name & ", Slide " & sld.SlideIndex
           End If
        End If
       Next
    Next

End Sub

Answer 2

要为David已经完成的工作添加一点，一旦你获得对文本范围（几乎任何文本块）的引用，你就可以获得文本的边界框并使用它来定位你的形状。这是一个开始：

Sub testMe()
    Dim oSh As Shape
    Dim oRng As TextRange

    ' As an example, use the currently selected shape:
    Set oSh = ActiveWindow.Selection.ShapeRange(1)

    With oSh.TextFrame.TextRange
        ' Does it contain the character we're looking for?
        If InStr(.Text, "N") > 0 Then
            ' Get a range representing that character
            Set oRng = .Characters(InStr(.Text, "N"), 1)
            ' And tell us the top
            Debug.Print TopOf(oRng)
            ' And as an exercise for the reader, do companion
            ' BottomOf, LeftOf, WidthOf functions below
            ' then use them here to position/size the shape
            ' atop the existing character
        End If
    End With

End Sub
Function TopOf(oRng As TextRange)
    TopOf = oRng.BoundTop
End Function

Powerpoint VBA：搜索角色箭头并替换为形状箭头

2 个答案: