Powerpoint VBA Update Shape from

Question

카탈로그로 사용하기 위해 pdf로 저장되는 ppt가 있습니다. 고유 한 제품 ID를 기반으로 텍스트 모양의 이름을 지정하고 액세스 데이터베이스에 대한 연결을 기반으로 텍스트 모양을 업데이트 할 수 있기를 바랍니다. 모양을 명명하고 입력 상자 (테스트 용)를 사용하여 vba로 값을 업데이트 할 수 있지만 모든 모양을 반복하고 고유 ID 기준과 일치하는 모양 텍스트를 업데이트하는 방법을 파악할 수 없습니다. 아래는 입력 상자에서 이름 바꾸기 및 업데이트를 테스트하기 위해 사용하는 것입니다.

하위 UpdateShape() 희미한 oShape 모양으로

Dim objName 
On Error GoTo CheckErrors 
If ActiveWindow.Selection.ShapeRange.Count = 0 Then 
    MsgBox "You need to select a shape first" 
    Exit Sub 
End If 
objName = ActiveWindow.Selection.ShapeRange(1).Name 

objName = InputBox$("Assign a new name and value to this shape", "Update Shape", objName) 
    If objName <> "" Then 
    ActiveWindow.Selection.ShapeRange(1).Name = objName 
    ActiveWindow.Selection.ShapeRange(1).TextFrame.TextRange.Text = objName 
End If 

Exit Sub 

CheckErrors : 있는 MsgBox 프로그램 Err.Description

최종 하위

내가 생각하고있는 것은 이름을 할 수있는 카탈로그 창조자입니다 셰이프는 카탈로그에 넣는 이미지를 기반으로합니다. 가격 책정은 카탈로그를 작성할 고객을 기준으로 데이터베이스에서 가져옵니다. vba가 데이터베이스 레코드를 반복하고 모양 ID와 일치하는 제품 ID를 기반으로 판매 가격을 반환하고 싶습니다.

내가 ("MySlide로")을 설정 oShape = ActivePresentation.Slides를 사용하여 시도했다

. 모양 ("은 myShape")와 oShape.TextFrame.TextRange.Text = "OBJNAME"

그러나 나는 텍스트를 얻을 수 없다 업데이트 및 "MySlide"대신 변수를 사용하는 방법을 알아낼 수 없습니다.

테이블의 이름은 tblProduct입니다. 제품 id 필드의 이름은 productid입니다. 판매 가격 필드의 이름은 saleprice입니다.

도움을 주셔서 감사합니다.

덕분에

Answer 1

, 당신은 당신이 필요로하는 하나를 찾기 위해 모든 슬라이드의 모든 모양을 통해 루프해야합니다. 프리젠 테이션을 통해 많은 패스를 유발하지만 완료까지는 오랜 시간이 걸리지 않아야합니다. 많은 프리젠 테이션/많은 교체 작업에도 몇 초.

Sub Test() 
    ' Call UpdateText for each replacement 
    UpdateText "This", "This is the text for shape named THIS" 
    UpdateText "That", "This is the text for shape named THAT" 
    UpdateText "The Other", "This is the text for shape named THE OTHER" 
End Sub 
Function UpdateText(sShapeName As String, sNewText As String) 
    Dim oSl As Slide 
    Dim oSh As Shape 

    For Each oSl In ActivePresentation.Slides 
     For Each oSh In oSl.Shapes 
      If UCase(oSh.Name) = UCase(sShapeName) Then 
       oSh.TextFrame.TextRange.Text = sNewText 
      End If 
     Next 
    Next 
End Function 

Answer 2

난 당신이 여기에서 발생하는 문제에 분명 아니지만, 당신의 모양은 위의 코드를 이름에 몇 가지 문제가 시작 할 수 있습니다. 의견을보고 아래의 세미 - 에어 코드를 시도하십시오. 찾아 프레젠테이션 어디에서나 나타날 수 있습니다 명명 된 모양을 수정하려면

Sub UpdateShape() 

Dim oShape As Shape 

' not strictly necessary, but generally best practice 
' to dim variables as the correct type 
Dim objName As String 

On Error GoTo CheckErrors 

' This won't work .... it throws error if no selection 
'If ActiveWindow.Selection.ShapeRange.Count = 0 Then 

If ActiveWindow.Selection.Type = ppSelectionShapes Then 
    If ActiveWindow.Selection.ShapeRange.Count = 1 Then 

     objName = ActiveWindow.Selection.ShapeRange(1).Name 
     objName = InputBox$("Assign a new name and value to this shape", "Update Shape", objName) 
      If objName <> "" Then 
       ActiveWindow.Selection.ShapeRange(1).Name = objName 
       ActiveWindow.Selection.ShapeRange(1).TextFrame.TextRange.Text = objName 
      End If 
      Exit Sub 
    End If 
End If 

MsgBox "You must choose one and only one shape first" 
Exit Sub 

CheckErrors: MsgBox Err.Description 

End Sub