2

我需要做的是找到一个向上箭头字符并将其替换为向上箭头形状并为向下箭头做同样的事情。我是 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 苦苦挣扎，如果你能给我任何帮助，我将不胜感激。

4

2 回答 2

4

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

在此处输入图像描述

首先，您需要确定您的角色的价值是什么。有很多地方可以找到这些参考资料。

然后，如何在您的代码中使用，这是一个找到形状并用箭头覆盖它的示例，根据@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
于 2013-10-09T15:38:28.933 回答
3

再补充一点 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
于 2013-10-09T23:27:32.703 回答