2014-06-13 74 views
0

我有一個PPT被保存爲PDF格式,用作目錄。我希望能夠根據唯一的產品ID命名文本形狀,然後根據與訪問數據庫的連接更新它們。我可以使用輸入框(用於測試)命名形狀並使用vba更新值,但我無法弄清楚如何遍歷所有形狀並根據匹配唯一ID標準更新形狀文本。以下是我用來從輸入框中測試重命名和更新的內容。Powerpoint VBA從數據庫更新形狀

子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與形狀名稱匹配返回銷售價格。

我已經使用set oShape = ActivePresentation.Slides( 「爲mySlide」)嘗試。形狀( 「MyShape的」)和 oShape.TextFrame.TextRange.Text = 「OBJNAME」

但我不能讓文本更新,我不知道如何使用變量來代替「MySlide」

表的名稱是tblProduct。產品id字段的名稱是productid。銷售價格字段的名稱是saleprice。

我感謝任何幫助,我可以得到。

感謝

回答

0

要查找和修改,可能在演示文稿中的任何位置出現了一個名爲形狀,你需要遍歷所有幻燈片的所有形狀,以找到您需要的一個。它觸發了演示文稿的大量傳遞,但不應該花很長時間才能完成。即使在大型演示/大量替換時也需要幾秒鐘。

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 
+0

Steve, 這正是我所追求的!我有它與我的變量工作。我將着手打開訪問查詢來遍歷記錄以更新每個字段。非常感謝您花時間回答我的問題。 – user3737686

+0

從我的Merge插件的又一次銷售中談起自己,是嗎? ;-) –

0

我不是你有問題就在這裏明確,但有你的形狀命名上面的代碼中的一些問題開始。查看評論並嘗試下面的半空中代碼。

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