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) 모든 문자 화살표를 찾아 삭제하면 도형 만 남게됩니다.

저는 PPT에서 VBA를 통해 자신의 길을 고민하고 있으며 저에게 줄 수있는 도움에 감사드립니다.

Answer 1

당신은 올바른 길을 가고 있습니다. 여기에 문자와 특수 문자가있는이 모양이 16 진수 값 &H25B2으로 표시된다고 가정합니다. 먼저

, 당신은 문자의 값이 무엇인지 파악해야합니다. 이 참조를 찾을 수있는 장소가 많이 있습니다.

그런 다음 코드에서 작업하는 방법, 여기에 비트를 추가하려면 :

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

아래 모양을 찾아 내고, @ SteveRindsberg의 제안에 따라 수정하여 화살표, 그것을 커버 한 예이다 데이비드가 이미 한 일에, 일단 텍스트 범위 (거의 모든 텍스트 덩어리)에 대한 참조를 얻으면 텍스트의 경계 상자를 가져 와서 모양을 배치하는 데 사용할 수 있습니다. 여기에 시작 :

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