Powerpoint VBA：搜索一個字符箭頭並用形狀箭頭代替

Question

我需要做的是找到一個向上的箭頭字符，並用向上的箭頭形狀替換它，併爲下來的箭頭做同樣的事情。我是VBA的新手，但對我希望宏如何工作有一個想法。它應該循環瀏覽幻燈片上的所有幻燈片。

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）查找並刪除所有字符箭頭，這樣形狀是唯一留下的字符。

我一直在努力通過VBA在PPT中的方式，並會感謝您可以給我的任何幫助。

Answer 1

你在正確的軌道上。假設我有這樣一個形狀，它有字母和一個特殊字符，用十六進制值&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 

Answer 2

增加一點一個例子大衛已經做了什麼，一旦你得到一個文本範圍的參考（幾乎任何文本塊），你可以得到文本的邊界框，並用它來定位你的形狀。這裏有一個開始：

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