-1

我正在尝试创建一个 ppt，其中包含来自 excel 的文本条目放置在几列中。

谷歌搜索了很多，但无法在运行时错误 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
4

1 回答 1

1

这更像是一组评论而不是答案，但评论字段不允许任何合理的格式。在线查看评论：

   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
于 2013-10-16T15:21:04.760 回答