粘贴幻灯片的时候运行时错误'-2147188160（80048240）

976190982 · 发表于 2021-10-15 13:05

本帖最后由 976190982 于 2021-10-16 10:59 编辑

粘贴幻灯片的时候运行时错误'-2147188160（80048240）
附件地址：https://wwi.lanzoui.com/isxENvd9kad 由于附件过大，就发地址了。

问题：在ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1) '粘贴至最后一张之后这里会出现运行时错误'-2147188160（80048240）
问题二、有时候页数也不对。

第一次写PPT的代码，EXCEL都还不是很了解，原贴是https://www.zhihu.com/question/393872545这个老师的，根据他提供的代码修改成我想要的代码。单步运行的时候没有问题，播放模式有时候就会出错。求老师们帮我看看，对PPT实在的不了解。
代码如下:

Sub PPT批量插入幻灯片图片文本框()
Dim pptPre As Presentation
Dim p, C As Long
Dim n As Integer
Dim myPath As String
Dim appExcel As Object
Dim myexcel As Object
Dim mysheet As Object
Dim rcount As Long
' On Error Resume Next
Set pptPre = ActivePresentation
myPath = ActivePresentation.Path & "\图片" '图片位置
Set appExcel = CreateObject("Excel.Application") '创建excel对象
Set myexcel = appExcel.Workbooks.Open(ActivePresentation.Path & "\数据.xlsx") '打开工作表
Set mysheet = myexcel.sheets("Sheet1") '创建工作表对象
rcount = mysheet.Cells(mysheet.Rows.Count, "A").End(3).Row '获取工作表最后一行行号
For p = 2 To rcount '从第2行到最后一行
If Dir(myPath & mysheet.Cells(p, "A").Value & ".jpg") <> "" Then '判断图片文件是否存在
n = n + 1
ActivePresentation.Slides(1).Copy '复制第一张幻灯片
ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1) '粘贴至最后一张之后
pptPre.Slides(ActivePresentation.Slides.Count).Shapes.AddPicture FileName:=myPath & _
mysheet.Cells(p, "A").Value & ".jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=25, Top:=150, Width:=275, Height:=294 '插入图片，设置坐标及长宽
'产品名称
With ActivePresentation.Slides(ActivePresentation.Slides.Count)
With .Shapes.AddTextbox(msoTextOrientationHorizontal, 124, 18, 300, 10) '文本框坐标及长宽
.TextFrame.TextRange.Font.Size = 18 '字号
.TextFrame.TextRange.Text = mysheet.Cells(p, 2).Value '文本内容
End With
End With
'日常价格
With ActivePresentation.Slides(ActivePresentation.Slides.Count)
With .Shapes.AddTextbox(msoTextOrientationHorizontal, 576, 16, 300, 10) '文本框坐标及长宽
.TextFrame.TextRange.Font.Size = 18 '字号
.TextFrame.TextRange.Text = mysheet.Cells(p, 3).Value '文本内容
End With
End With
'店铺名称
With ActivePresentation.Slides(ActivePresentation.Slides.Count)
With .Shapes.AddTextbox(msoTextOrientationHorizontal, 835, 15, 300, 10) '文本框坐标及长宽
.TextFrame.TextRange.Font.Size = 14 '字号
.TextFrame.TextRange.Text = mysheet.Cells(p, 4).Value '文本内容
End With
End With
'物流
With ActivePresentation.Slides(ActivePresentation.Slides.Count)
With .Shapes.AddTextbox(msoTextOrientationHorizontal, 111, 62, 300, 10) '文本框坐标及长宽
.TextFrame.TextRange.Font.Size = 14 '字号
.TextFrame.TextRange.Text = mysheet.Cells(p, 5).Value '文本内容
End With
End With
'几天发货
With ActivePresentation.Slides(ActivePresentation.Slides.Count)
With .Shapes.AddTextbox(msoTextOrientationHorizontal, 313, 62, 300, 10) '文本框坐标及长宽
.TextFrame.TextRange.Font.Size = 14 '字号
.TextFrame.TextRange.Text = mysheet.Cells(p, 6).Value '文本内容
End With
End With
'直播价格
With ActivePresentation.Slides(ActivePresentation.Slides.Count)
With .Shapes.AddTextbox(msoTextOrientationHorizontal, 576, 61, 300, 10) '文本框坐标及长宽
.TextFrame.TextRange.Font.Size = 14 '字号
.TextFrame.TextRange.Text = mysheet.Cells(p, 7).Value '文本内容
End With
End With
'库存情况
With ActivePresentation.Slides(ActivePresentation.Slides.Count)
With .Shapes.AddTextbox(msoTextOrientationHorizontal, 838, 59, 300, 10) '文本框坐标及长宽
.TextFrame.TextRange.Font.Size = 14 '字号
.TextFrame.TextRange.Text = mysheet.Cells(p, 8).Value '文本内容
End With
End With
'材质
With ActivePresentation.Slides(ActivePresentation.Slides.Count)
With .Shapes.AddTextbox(msoTextOrientationHorizontal, 312, 138, 300, 10) '文本框坐标及长宽
.TextFrame.TextRange.Font.Size = 14 '字号
.TextFrame.TextRange.Text = mysheet.Cells(p, 9).Value '文本内容
End With
End With
'尺码
With ActivePresentation.Slides(ActivePresentation.Slides.Count)
With .Shapes.AddTextbox(msoTextOrientationHorizontal, 87, 485, 300, 10) '文本框坐标及长宽
.TextFrame.TextRange.Font.Size = 14 '字号
.TextFrame.TextRange.Text = mysheet.Cells(p, 10).Value '文本内容
End With
End With
End If
Next p
myexcel.Close
Set pptPre = Nothing
Set appExcel = Nothing
Set myexcel = Nothing
Set mysheet = Nothing
MsgBox "全部PPT已添加完成，若要外发请删除第一页模板页！！", vbExclamation + vbOKOnly, "提示"
End Sub

复制代码

解决方法:
帮忙ActiveWindow.view.paste 错误_百度知道 (baidu.com)

前进者 · 发表于 2022-2-26 15:13

做个标记，以便学习！

		自动登录	找回密码
密码			免费注册

[已解决] 粘贴幻灯片的时候运行时错误'-2147188160（80048240）