Excel VBA運行時錯誤2147188160（80048240）自動化錯誤

-1

我想創建一個ppt，其中包含幾個列中放置的excel文本項。Excel VBA運行時錯誤2147188160（80048240）自動化錯誤

已經搜索了很多，但無法在運行時錯誤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

來源

2013-10-15 Anant

http://support.microsoft.com/kb/285472 – pnuts

@PortlandRunner我也嘗試從鏈接的解決方案。如果您看到代碼 - newPPT.Visible = True - 已經在適當的地方添加 - 正如鏈接所建議的那樣。 – Anant

@pnuts以前檢查過這個鏈接。並試用了該代碼。但它沒有工作。在鏈接中提到，這種解決方法可能對Powerpoint 2007無效。（不幸的是，這是我擁有的版本） – Anant

這更是一個集不是答案的評論，但註釋字段不允許任何合理的格式。看評論在線：

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-16 15:21:04

Excel VBA運行時錯誤2147188160（80048240）自動化錯誤

回答

相關問題