为什么vba循环在第一轮后失败？

我的代码是创建工作表，然后在名为“Sheet…”的工作表上绘制图表，然后创建powerpoint。然后，它删除所有工作表并重新开始。图表创建部分可以工作，但当涉及到创建powerpoint时，代码跳过了IF语句。它在第一轮有效，但在那之后它会跳过

Dim ppt         As PowerPoint.Application
Set ppt = New PowerPoint.Application

ppt.Visible = msoTrue

'如有必要，请更改模板源

ppt.Presentations.Open "C:\Desktop\Template\PowerPoint_Template.potx", _
Untitled:=msoTrue

ppt.Activate

Dim ppt_pres    As PowerPoint.Presentation
Set ppt_pres = ppt.ActivePresentation

Dim ppt_layout  As CustomLayout
Set ppt_layout = ppt_pres.Slides(2).CustomLayout

Dim ppt_slide   As PowerPoint.Slide
Set ppt_slide = ppt_pres.Slides.AddSlide(2, ppt_layout)

Dim ppt_shape   As PowerPoint.Shape
Set ppt_shape = ppt_slide.Shapes(1)

Dim ppw As Object
Set ppw = ppt_pres.Windows(ppt_pres.Windows.Count)

Dim wsPIA As Worksheet
Set wsPIA = Sheet4

'命名标题幻灯片

ppt_pres.Slides(1).Shapes(3).TextFrame.TextRange.Text = wsPIA.Range("C2") 
ppt_pres.Slides(1).Shapes(2).TextFrame.TextRange.Text = wsPIA.Range("I2") 

'标识包含新创建图表的图纸数量

Dim j As Integer, vNames() As Variant, ws As Worksheet, picture As Shape
j = 0
For Each ws In ThisWorkbook.Worksheets
If Left(ws.Name, 5) = "Sheet" Then
j = j + 1
ReDim Preserve vNames(j)
vNames(j) = ws.Name
End If
Next ws

Application.DisplayAlerts = False

'将图表从excel循环复制粘贴到powerpoint

For Each ws In Worksheets

If Left(ws.Name, 5) = "Sheet" Then
    ws.Select

    For Each picture In ActiveSheet.Shapes
            picture.Copy

        ppw.View.GotoSlide ppt_pres.Slides.Count - 1

            ppt_slide.Shapes.PasteSpecial ppPasteEnhancedMetafile

        ppt_slide.Shapes(7).Height = 390
        ppt.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoCTrue
        ppt.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
        ppt_slide.Shapes(7).Top = ppt_slide.Shapes(7).Top + 14
        ppt_slide.Shapes.Title.TextFrame.TextRange.Text = wsPIA.Range("C2")
        ppt_slide.Shapes(4).TextFrame.TextRange.Text =wsPIA.Range("I2")


        ppw.View.GotoSlide ppt_pres.Slides.Count - 1


Set ppt_slide = ppt_pres.Slides.AddSlide(ppt_pres.Slides.Count - 1, ppt_layout)



    Next

End If

Next

'从结尾删除空白幻灯片

ppt_pres.Slides.item(ppt_pres.Slides.Count - 1).Delete
ppt_pres.Slides.item(ppt_pres.Slides.Count - 1).Delete

With ppt_pres
.SaveAs ("C:\Desktop\Presentations\Pres1.pptx")
.Close

End With

第一轮，行：

如果左（ws.Name，5）=“Sheet”，则为ws。挑选

是真的，但在第一次迭代之后，它跳过了这一点，直接转到

---

'从结尾删除空白幻灯片

有多少张幻灯片满足此条件？我觉得你的情况很好。另外，请在删除下一行

ws后重试。选择您不需要的
。将
Activesheet
替换为
ws
中的
Activesheet.Shapes
我想这就是问题所在我现在有12张。第一轮是“Sheet1”、“Sheet2”等，第二轮是“Sheet13”、“Sheet14”、“Sheet15”等。我试过了，但它仍然跳过了IF-statement。尝试使用
F8
在调试模式下运行代码，看看在每次迭代中
ws.name
的值是多少。
ppt_pres.Slides.item(ppt_pres.Slides.Count - 1).Delete
ppt_pres.Slides.item(ppt_pres.Slides.Count - 1).Delete

With ppt_pres
.SaveAs ("C:\Desktop\Presentations\Pres1.pptx")
.Close

End With