自动化错误

[baidu_35656988]

红色的是调试后标记出来的代码。
Private Sub OutPutPPt()
Set ptApp = New PowerPoint.Application
ptApp.Visible = msoTrue
Dim ptPres As Presentation
Set ptPres = ptApp.Presentations.Add
Dim ptSlide As Slide
Dim pcLayout As CustomLayout
Set pcLayout = ptPres.SlideMaster.CustomLayouts.Add(1)
Set ptSlide = ptPres.Slides.AddSlide(1, pcLayout)
ptSlide.Background.Fill.UserPicture "C:\Users\BIMTech\Desktop\图片1.png"
ptSlide.Shapes(1).Top = 160
ptSlide.Shapes(1).Left = 50
ptSlide.Shapes(1).Width = 600
ptSlide.Shapes(1).Height = 180
ptSlide.Shapes(1).Fill.BackColor.RGB = RGB(79, 129, 189)
ptSlide.Shapes(1).TextFrame.TextRange.Text = Title
Dim i
For i = 0 To UBound(Datas)
Label4.Caption = "正在写入..."
Set ptSlide = ptPres.Slides.AddSlide(i + 2, pcLayout)
ptSlide.Background.Fill.UserPicture "C:\Users\BIMTech\Desktop\图片1.png"
With ptSlide.Shapes.AddTable(2, 1, 30, 30)
.Table.Rows(1).Height = 100
.Table.Rows(2).Height = 350
.Table.Cell(1, 1).Split 2, 2
.Table.Columns(1).Width = 120
.Table.Columns(2).Width = 540
.Table.Cell(1, 1).Shape.Fill.BackColor.RGB = RGB(79, 129, 189)
.Table.Cell(1, 2).Shape.Fill.BackColor.RGB = RGB(79, 129, 189)
.Table.Cell(1, 1).Shape.TextFrame.TextRange.Text = Datas(i).ImpactID
.Table.Cell(1, 2).Shape.TextFrame.TextRange.Text = Datas(i).ImpactAdress
.Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = Datas(i).Floor

.Table.Cell(2, 2).Split 1, 2
.Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = Datas(i).ProName1
.Table.Cell(2, 3).Shape.TextFrame.TextRange.Text = Datas(i).ProName2
.Table.Cell(3, 1).Split 1, 2
ptSlide.Shapes.AddPicture Datas(i).PictureLink, msoFalse, msoTrue, 35, 135, 305, 310
End With
ptSlide.Shapes.Item(1).Delete
Label4.Caption = "正在写入......"
Next
MsgBox "完成写入！"
'ptPres.SaveAs FolderName & Title & ".ppt"
'ptPres.Close
'Set ptApp = Nothing
End Sub

[baidu_35656988]

我去。。。。太黄了




-------------我帮你改了。。

[baidu_35656988]

坐等大神。。。。我是小白。。。。很白的那种