Excel VBA运行时错误2147188160（80048240）自动化错误

我试图创建一个ppt，将excel中的文本条目放在两列中

谷歌搜索了很多，但在运行时错误2147188160（80048240）自动化错误方面没有取得任何进展

在micrsoft网站上找到了这个链接，上面说这是Office2007中的一个bug。任何人都可以提出任何解决办法

我的代码如下：

    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

---

这更多的是一组注释而不是答案，但是注释字段不允许任何合理的格式。请参阅在线评论：

   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

---

@PortlandRunner我确实尝试了链接中的解决方案。如果您看到代码-newPPT.Visible=True-这已经被添加到适当的位置-正如链接所建议的那样。@pnuts以前检查过这个链接。并尝试了该代码。但它不起作用。链接中提到，此解决方案可能不适用于Powerpoint 2007。（不幸的是，这是我的版本）@PortlandRunner我是VBA新手。我是否在建议的变通方法的语法中犯了某种错误。您上面引用的文章是关于PowerPoint 95又名PowerPoint 7的，而不是PowerPoint 2007。这可以追溯到PowerPoint内置VBA之前。我不会太注意它。两个问题：您是否添加了对PowerPoint的引用？错误发生在哪一行？@SteveRindsberg 1。已添加Powerpoint 12.0对象库。