Question

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

我最近写信给PowerPoint时感到很沮丧，我不得不恢复硬编码，我讨厌做但却别无选择。

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

此选择案例代码并不总能找到我需要更新的形状。

        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 结构来循环集合，例如

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

但你提到了关键词“删除”。

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

所以，请改用：

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

PowerPoint形状不在形状集合中

1 个答案: