PowerPoint形状不在形状集合

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并不总是找到我需要更新的形状吗？

这是我的整个循环，其中包括删除一个项目并将其替换为一个图片和居中的图片形状！ OH，是否删除了足以丢弃代码的项目？也许我应该在Loop之后删除那个Shape？

' 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

您也可以通过收集使用对于每个结构循环例如

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

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

如果您要删除在VBA中循环访问的Collection中的任何对象，则必须向后循环！

所以，改用此：

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