【发布时间】：2013-10-23 07:35:30
【问题描述】：
我正在尝试创建一个 ppt，其中将 excel 中的文本条目放置在几列中。
在 Google 上搜索了很多，但无法在运行时错误 2147188160 (80048240) 自动化错误上取得任何进展。
在 micrsoft 网站 http://support.microsoft.com/kb/155073 上找到此链接，该链接表示这是 Office 2007 中的一个错误。任何人都可以提出任何解决方法。
我的代码如下：
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
【问题讨论】：
-
@PortlandRunner 我确实尝试了链接中的解决方案。如果您看到代码 - newPPT.Visible = True - 这已经添加到适当的位置 - 正如链接所建议的那样。
-
@pnuts 之前检查过此链接。并尝试了该代码。但它没有用。在链接中提到此解决方法可能不适用于 Powerpoint 2007。（不幸的是，这是我拥有的版本）
-
@PortlandRunner 我是 VBA 新手。我是否在建议的解决方法的语法中犯了某种错误。
-
您上面引用的文章是关于 PowerPoint 95 aka PowerPoint 7，而不是 PowerPoint 2007。这可以追溯到 PowerPoint 内置 VBA 之前。我不会过多关注它。两个问题：您是否添加了对 PowerPoint 的引用以及错误发生在哪一行？
-
@SteveRindsberg 1. 添加了 Powerpoint Powerpoint 12.0 对象库。
标签： excel vba runtime-error powerpoint powerpoint-2007