PowerPoint 形状不在形状集合中

Question

MS Access VBA 更新 PowerPoint 演示文稿的代码。

我最近对写 PowerPoint 感到沮丧，因为我不得不恢复硬编码，我讨厌这样做但别无选择。

使用 Do Until intShapes > objPPPresentation.Slides(1).Shapes.Count 并不总能获得幻灯片 1 上的所有形状！

这个Select案例代码并不总能找到我需要更新的形状。

        Select Case objPPPresentation.Slides(intSlide).Shapes(intShapes).Name
        Case Is = "BuildingAddress"
            objPPPresentation.Slides(intSlide).Shapes(intShapes).TextFrame.TextRange.Text = Nz(Me.txtStreetNumber, "") & " " & UCase(Nz(Me.txtAddress, ""))

所以我改为这样做，每次都有效。

objPPPresentation.Slides(intSlide).Shapes("BuildingName").TextFrame.TextRange.Text = Nz(Me.txtStreetNumber, "") & " " & UCase(Nz(Me.txtAddress, ""))

谁能解释一下为什么 Shapes.Count 总不能找到我需要更新的形状？

这是我的整个循环，包括删除一个项目并将其替换为图片并将图片形状居中！哦，删除一个项目是否足以摆脱代码？也许我应该在处理循环之后删除那个形状？

    ' Page ONE First.
Do Until intShapes > objPPPresentation.Slides(1).Shapes.Count
    'Debug.Print objPPPresentation.Slides(intSlide).Shapes(intShapes).ID & ":" & objPPPresentation.Slides(1).Shapes(intShapes).Name

    Select Case objPPPresentation.Slides(intSlide).Shapes(intShapes).Name
        Case Is = "BuildingAddress"
            objPPPresentation.Slides(intSlide).Shapes(intShapes).TextFrame.TextRange.Text = Nz(Me.txtStreetNumber, "") & " " & UCase(Nz(Me.txtAddress, ""))

        Case Is = "BuildingName"
            objPPPresentation.Slides(intSlide).Shapes(intShapes).TextFrame.TextRange.Text = UCase(Nz(Me.cboBuilding.Column(1), ""))

        Case Is = "tableData"
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(1).Cells(2).Shape.TextFrame.TextRange.Text = "Floors: " & Nz(Me.txtFloors, "")
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(2).Cells(2).Shape.TextFrame.TextRange.Text = Nz(Me.txtAvailability, "")
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(3).Cells(2).Shape.TextFrame.TextRange.Text = Nz(Me.txtLeaseTerm, "")
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(4).Cells(2).Shape.TextFrame.TextRange.Text = "WHERE FROM?"
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(5).Cells(2).Shape.TextFrame.TextRange.Text = Nz(Me.txtAskingNetRent, "")
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(6).Cells(2).Shape.TextFrame.TextRange.Text = Nz(Me.TIA, "")
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(7).Cells(2).Shape.TextFrame.TextRange.Text = "WHERE FROM?"
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(8).Cells(2).Shape.TextFrame.TextRange.Text = Nz(Me.txtHVACHours, "")
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(9).Cells(2).Shape.TextFrame.TextRange.Text = Nz(Me.txtSecurity, "")
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(10).Cells(2).Shape.TextFrame.TextRange.Text = "GetPlus15 Function!"
            objPPPresentation.Slides(intSlide).Shapes(intShapes).Table.Rows(11).Cells(2).Shape.TextFrame.TextRange.Text = Nz(Me.txtComments, "")

        Case Is = "pictureBuildingPhoto"
            imageWidth = GetGraphicWidthOrHeight(strExportFolder & strBuildingPhotoFileName, "Width")
            imageHeight = GetGraphicWidthOrHeight(strExportFolder & strBuildingPhotoFileName, "Height")
            ' The ratio of image Pixels vs. Shape sizes is.
            imageWidth = imageWidth * (71 / 96)
            imageHeight = imageHeight * (71 / 96)

            ' Can't change the image of a picture object so this Shape has been removed from the Template
            Set pptShape = objPPPresentation.Slides(intSlide).Shapes(intShapes)

            Top = objPPPresentation.Slides(intSlide).Shapes(intShapes).Top
            Left = objPPPresentation.Slides(intSlide).Shapes(intShapes).Left
            Height = objPPPresentation.Slides(intSlide).Shapes(intShapes).Height
            Width = objPPPresentation.Slides(intSlide).Shapes(intShapes).Width
            pptShape.Delete

            If imageHeight > imageWidth Then
                Left = Left + ((Width / 2) - (imageWidth / 2))
                objPPPresentation.Slides(intSlide).Shapes.AddPicture strExportFolder & strBuildingPhotoFileName, msoFalse, msoCTrue, _
                Left, Top, -1, Height
            Else
                'Adjust Top value so the image in centered
                Top = Top + ((Height / 2) - (imageHeight / 2))
                objPPPresentation.Slides(intSlide).Shapes.AddPicture strExportFolder & strBuildingPhotoFileName, msoFalse, msoCTrue, _
                Left, Top, Width, -1
            End If

    End Select

    intShapes = intShapes + 1
Loop

Answer 1

您还可以使用 For Each 结构来遍历 Collection，例如

Dim oShp As Shape
Dim oSld As Slide
For Each oShp In oSld.Shapes
  ' Do suff
Next

但是你提到了关键词"Delete"。

如果您要删除集合中您在 VBA 中循环的任何对象，您必须向后循环！

所以，改用这个：

Dim intLoop As Integer
For intLoop = objPPPresentation.Slides(1).Shapes.Count to 1 Step -1

PowerPoint 形状不在形状集合中

PowerPoint Shape not in the Shape Collection

ms-access

powerpoint

vba

ms-access-2010