Question

我的代码假设是先创建工作表，然后在名称为“ Sheet ...”的工作表上创建图表，然后创建PowerPoint。然后删除所有工作表，然后重新开始。图表创建部分可以工作，但是在创建PowerPoint时，代码将跳过IF语句。它在第一轮工作，但之后跳过IF。

Transaction

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

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")

'将图表从Excel粘贴到Powerpoint

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

'从末尾删除空白幻灯片

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

第一轮：

如果Left（ws.Name，5）=“ Sheet”，则ws。选择

是正确的，但是在第一次迭代之后，它会跳过它并直接进入

'从末尾删除空白幻灯片

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

0 个答案: