Excel VBA 运行时错误 2147188160 (80048240) 自动化错误
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19382220/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
提示：将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间：2020-09-11 23:50:13 来源:igfitidea点击:
Excel VBA Run-time error 2147188160 (80048240) Automation Error
提问by Anant
I am trying to create a ppt with text entries from excel placed in couple of columns.
我正在尝试创建一个 ppt，其中包含来自 excel 的文本条目放置在几列中。
Have googled a lot but not able to make any headway on Run-time error 2147188160 (80048240) Automation Error.
谷歌搜索了很多，但无法在运行时错误 2147188160 (80048240) 自动化错误上取得任何进展。
Found this link on micrsoft site http://support.microsoft.com/kb/155073which says this is a bug in Office 2007. Any one can suggest any workarounds.
在 micrsoft 网站http://support.microsoft.com/kb/155073上找到了这个链接，它说这是 Office 2007 中的一个错误。任何人都可以提出任何解决方法。
My code is as follows:
我的代码如下：
Sub CreateSlides()
Dim aData As String
Dim newPPT As PowerPoint.Application
Dim Actslide As PowerPoint.Slide
Dim Actshape As PowerPoint.Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long
Dim i, x, rowcount, slinum, slicount As Integer
Dim Size As Integer
Set newPPT = New PowerPoint.Application
newPPT.Presentations.Add
newPPT.ActivePresentation.Slides.Add newPPT.ActivePresentation.Slides.Count + 1, ppLayoutBlank
newPPT.Visible = msoTrue
lngSlideHeight = newPPT.ActivePresentation.PageSetup.SlideHeight
lngSlideWidth = newPPT.ActivePresentation.PageSetup.SlideWidth
ActiveSheet.Cells(1, 1).Select
rowcount = ActiveSheet.UsedRange.Rows.Count
slinum = 1
x = 1
'create slides
For slinum = 1 To 2 * rowcount + 10
Set Actslide = newPPT.ActivePresentation.Slides(slinum)
newPPT.ActivePresentation.Slides.Add newPPT.ActivePresentation.Slides.Count + 1, ppLayoutBlank
Next slinum
'copy words
slinum = 1
x = 1
For x = 1 To rowcount
ActiveSheet.Cells(x, 1).Select
Selection.Copy
newPPT.Visible = True
newPPT.ActiveWindow.View.GotoSlide (slinum)
newPPT.ActiveWindow.Panes(2).Activate
Set Actslide = newPPT.ActivePresentation.Slides(slinum)
newPPT.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault
newPPT.ActiveWindow.Selection.ShapeRange.Top = (lngSlideHeight - newPPT.ActiveWindow.Selection.ShapeRange.Height) / 2
newPPT.ActiveWindow.Selection.ShapeRange.Height = 400
newPPT.ActiveWindow.Selection.ShapeRange.Left = 1
newPPT.ActiveWindow.Selection.ShapeRange.Width = lngSlideWidth - 1
newPPT.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
newPPT.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Font.Size = 48
If slinum Mod 9 = 0 Then
slinum = slinum + 9
End If
slinum = slinum + 1
Next x
slicount = 2 * rowcount + 10
slinum = 10
x = 1
i = 1
For x = 1 To rowcount
ActiveSheet.Cells(x, 2).Select
Selection.Copy
If i = 1 Then
newPPT.Visible = True
newPPT.ActiveWindow.Panes(2).Activate
newPPT.ActiveWindow.View.GotoSlide (slinum + 2)
Else
If i = 2 Then
newPPT.Visible = True
newPPT.ActiveWindow.Panes(2).Activate
newPPT.ActiveWindow.View.GotoSlide (slinum)
Else
If i = 3 Then
newPPT.Visible = True
newPPT.ActiveWindow.Panes(2).Activate
newPPT.ActiveWindow.View.GotoSlide (slinum - 2)
End If
End If
End If
i = i + 1
If i = 4 Then
i = 1
End If
newPPT.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault
newPPT.ActiveWindow.Selection.ShapeRange.Top = (lngSlideHeight - newPPT.ActiveWindow.Selection.ShapeRange.Height) / 2
newPPT.ActiveWindow.Selection.ShapeRange.Height = 400
newPPT.ActiveWindow.Selection.ShapeRange.Left = 1
newPPT.ActiveWindow.Selection.ShapeRange.Width = lngSlideWidth - 1
newPPT.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
newPPT.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Font.Size = 28
If slinum Mod 9 = 0 Then
slinum = slinum + 9
End If
If slinum > slicount Then
Exit For
End If
slinum = slinum + 1
Next x
End Sub
回答by Steve Rindsberg
This is more a set of comments than an answer, but the comment fields don't allow for any reasonable formatting. See comments in-line:
这与其说是答案，不如说是一组评论，但评论字段不允许任何合理的格式。在线查看评论：
Sub CreateSlides()
Dim aData As String
Dim newPPT As PowerPoint.Application
Dim Actslide As PowerPoint.Slide
Dim Actshape As PowerPoint.Shape
' SlideHeight and Width are Singles, not Longs
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long
' Here, you've DIMmed all of the variables as variants, not integers:
Dim i, x, rowcount, slinum, slicount As Integer
' You really want:
' Dim i as Long, x as Long ....etc.
' Note that most if not all of these should be longs, not integers
' Generally, VBA will convert for you as needed, but once in a while it'll
' turn round and bite you. Better to use the correct data types in the first place.
Dim Size As Integer
Set newPPT = New PowerPoint.Application
' I'd move this here rather than below:
newPPT.Visible = msoTrue
newPPT.Presentations.Add
newPPT.ActivePresentation.Slides.Add newPPT.ActivePresentation.Slides.Count + 1, ppLayoutBlank
' newPPT.Visible = msoTrue
lngSlideHeight = newPPT.ActivePresentation.PageSetup.SlideHeight
lngSlideWidth = newPPT.ActivePresentation.PageSetup.SlideWidth
ActiveSheet.Cells(1, 1).Select
' Check what UsedRange returns against what you THINK it's supposed to return.
' Sometimes it's not quite what you expect:
rowcount = ActiveSheet.UsedRange.Rows.Count
' No need for either of these; the For/Next syntax takes care of that
'slinum = 1
'x = 1
'create slides
For slinum = 1 To 2 * rowcount + 10
Set Actslide = newPPT.ActivePresentation.Slides(slinum)
newPPT.ActivePresentation.Slides.Add newPPT.ActivePresentation.Slides.Count + 1, ppLayoutBlank
Next slinum
'copy words
slinum = 1
x = 1
For x = 1 To rowcount
ActiveSheet.Cells(x, 1).Select
Selection.Copy
newPPT.Visible = True
newPPT.ActiveWindow.View.GotoSlide (slinum)
newPPT.ActiveWindow.Panes(2).Activate
Set Actslide = newPPT.ActivePresentation.Slides(slinum)
newPPT.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault
newPPT.ActiveWindow.Selection.ShapeRange.Top = (lngSlideHeight - newPPT.ActiveWindow.Selection.ShapeRange.Height) / 2
newPPT.ActiveWindow.Selection.ShapeRange.Height = 400
newPPT.ActiveWindow.Selection.ShapeRange.Left = 1
newPPT.ActiveWindow.Selection.ShapeRange.Width = lngSlideWidth - 1
newPPT.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
newPPT.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Font.Size = 48
If slinum Mod 9 = 0 Then
slinum = slinum + 9
End If
slinum = slinum + 1
Next x
slicount = 2 * rowcount + 10
slinum = 10
x = 1
i = 1
For x = 1 To rowcount
ActiveSheet.Cells(x, 2).Select
Selection.Copy
If i = 1 Then
newPPT.Visible = True
newPPT.ActiveWindow.Panes(2).Activate
newPPT.ActiveWindow.View.GotoSlide (slinum + 2)
Else
If i = 2 Then
newPPT.Visible = True
newPPT.ActiveWindow.Panes(2).Activate
newPPT.ActiveWindow.View.GotoSlide (slinum)
Else
If i = 3 Then
newPPT.Visible = True
newPPT.ActiveWindow.Panes(2).Activate
newPPT.ActiveWindow.View.GotoSlide (slinum - 2)
End If
End If
End If
i = i + 1
If i = 4 Then
i = 1
End If
newPPT.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault
newPPT.ActiveWindow.Selection.ShapeRange.Top = (lngSlideHeight - newPPT.ActiveWindow.Selection.ShapeRange.Height) / 2
newPPT.ActiveWindow.Selection.ShapeRange.Height = 400
newPPT.ActiveWindow.Selection.ShapeRange.Left = 1
newPPT.ActiveWindow.Selection.ShapeRange.Width = lngSlideWidth - 1
newPPT.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
newPPT.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Font.Size = 28
If slinum Mod 9 = 0 Then
slinum = slinum + 9
End If
If slinum > slicount Then
Exit For
End If
slinum = slinum + 1
Next x
End Sub
