Question

我有一个ppt被保存为pdf用作目录。我希望能够根据唯一的产品ID命名文本形状，然后根据与访问数据库的连接更新它们。我可以使用输入框命名形状并使用vba更新值（用于测试）但我无法弄清楚如何遍历所有形状并根据匹配唯一ID标准更新形状文本。以下是我用于测试从输入框重命名和更新的内容。

Sub UpdateShape（） Dim oShape As Shape

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

End Sub

我的目的是让目录创建者根据他们放在目录中的图像来命名形状。定价将来自数据库，该数据库基于为其创建目录的客户。我想让vba遍历数据库记录并根据产品ID与形状名称的匹配返回销售价格。

我尝试过使用Set oShape = ActivePresentation.Slides（＆＃34; MySlide＆＃34;）。形状（＆＃34; MyShape＆＃34;）和 oShape.TextFrame.TextRange.Text =＆＃34; objName＆＃34;

但是我无法更新文本，我无法弄清楚如何使用变量代替＆＃34; MySlide＆＃34;

表的名称是tblProduct。产品ID字段的名称是productid。销售价格字段的名称是saleprice。

我感谢任何帮助。

由于

Answer 1

我不清楚你在这里遇到的问题，但首先，你的形状命名代码存在一些问题。查看评论并尝试下面的半航空代码。

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

Answer 2

要查找和修改可能出现在演示文稿中任何位置的命名形状，您需要遍历所有幻灯片上的所有形状，以便找到所需的形状。它触发了大量的演示文稿，但不应该花费很长时间才能完成。即使是大型演示/大量替换，也要几秒钟。

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

Powerpoint VBA从数据库更新形状

2 个答案: