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