Excel VBA 런타임 오류 2147188160 (80048240) 자동화 오류

Question

Excel 항목에서 두 개의 열에 배치 된 Excel 항목을 사용하여 ppt를 만들려고합니다.

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 

Answer 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