首页 文章

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

提问于
浏览
1

我需要做的是找到一个向上箭头字符并用向上箭头形状替换它并为向下的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,并感谢你能给我的任何帮助 .

2 回答

  • 4

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

    enter image description here

    首先,您需要确定角色的 Value . 有很多地方可以找到这些参考资料 .

    然后,如何在你的代码中使用,这里是一个找到形状的例子,并用你的箭头覆盖它,根据@ 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
    
  • 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
    

相关问题