Solved

VBA Works in Excel 2007 Not in 2013 Copy to PPT

Posted on 2013-12-04
5
1,653 Views
Last Modified: 2013-12-05
Hi,

I have been using the below code for a long time in Excel 2007 and PPT 2007. I am now using Excel 2013 and PPT 2013 and the code is erroring out at

For lngRow = Range("FirstRange").Row To Cells(Rows.Count, Range("FirstRange").Column).End(xlUp).Row

Saying  Run time error '1004': Method 'Range' of object'_Globail' failed

I also get an error saying object not defined at

With shShape
        .LockAspectRatio = 0


Not sure what the issue is

Sub UpdatePPT()

    Dim oPPTApp As PowerPoint.Application
    Dim oPPTShape As PowerPoint.Shape
    Dim shtControl As Worksheet
    Dim rngNewRange As Excel.Range, strSlideNum As String
    Dim oSheet As Object, shShape As Object, nmName As Name
    Dim lngRow As Long, strLeaveOpen As String, strPrevWbk As String, _
        blPrevWbkXist As Boolean
    Dim strWbk As String, strRange As String, intSlideNum As Integer, _
        intWidth As Integer, intTop As Integer, intLeft As Integer, _
        intHeight As Integer, strWbkName As String, strError As String, ExcelSlide As String
    Dim Answer As String
    Dim MyMessage As String
    Dim DrugSelected As String
    Dim Parameter As String

    Application.ScreenUpdating = False

    '
    ' Set oPPTApp to PowerPoint by creating a new instance of PowerPoint.
    ' If PowerPoint is already open, you would instead use the GetObject
    ' method instead.

    DrugSelected = Worksheets("Parameters").Range("J150").Value
    Parameter = Worksheets("Parameters").Range("J151").Value
    MyMessage = ("You are about to copy drug information for " & DrugSelected & " with Parameter " & Parameter & " information to PowerPoint, please click Yes to proceed or No to end process")
    Answer = MsgBox(MyMessage, vbQuestion + vbYesNo)

    Call wsProtection
    If Answer = vbYes Then

        Set shtControl = Worksheets("Copy to PPT")
        Set oPPTApp = CreateObject("PowerPoint.Application")

        ' Set PowerPoint to be Visible.
        '
        oPPTApp.Visible = msoTrue
        '
        ' Open Presentation
        '
        oPPTApp.Presentations.Open Worksheets("Copy to PPT").Range("PPT_Path").Value
        ' Delete existing shapes
        If Worksheets("Copy to PPT").Range("I1").Value = "YES" Then
            delPPTShapesActiveSlide
        ElseIf Worksheets("Copy to PPT").Range("I1").Value = "NO" Then
            Worksheets("Copy to PPT").Range("I1").Value = "YES"
        End If
        'Loop through all Range lines
        For lngRow = Range("FirstRange").Row To Cells(Rows.Count, Range("FirstRange").Column).End(xlUp).Row
.
            If UCase(shtControl.Cells(lngRow, 9).Value) = "NO" Then GoTo endLoop1

            With shtControl
                strRange = .Cells(lngRow, 3).Value
                intTop = .Cells(lngRow, 4).Value
                intLeft = .Cells(lngRow, 5).Value
                intWidth = .Cells(lngRow, 6).Value
                intHeight = .Cells(lngRow, 7).Value
                intSlideNum = .Cells(lngRow, 8).Value
                ExcelSlide = .Cells(lngRow, 3).Value
            End With


            'transfer to Powerpoint
            strError = strError & CopyRangeToPPT(oPPTApp, intSlideNum, intLeft, intWidth, intHeight, intTop, strRange, ExcelSlide)

endLoop1:
        Next

        oPPTApp.Activate

        Set oPPTApp = Nothing

    Else
        Exit Sub

    End If

    Worksheets("Copy to PPT").Select


    Call wsProtection

    Application.ScreenUpdating = True

    MsgBox "Power Point Update Complete"

End Sub
Sub GetPPTPath()
    Range("PPT_Path").Value = Application.GetOpenFilename
End Sub
Sub GetXLPath()
    Range("XL_Path").Value = Application.GetOpenFilename
End Sub
Function CopyRangeToPPT(oPPTApp As PowerPoint.Application, intSlideNum As Integer, intLeft As Integer, intWidth As Integer, intHeight As Integer, intTop As Integer, strRange As String, ExcelSlide As String) As String
    Dim shShape As Object, strError As String

    'delete shape if it exists on slide
    On Error Resume Next
    oPPTApp.ActivePresentation.Slides("Slide_" & strRange).Shapes("ExcelSlide_" & strRange).Delete
    If Err.Number <> 0 Then CopyRangeToPPT = Err.Number & " " & Err.Description & ": " & strRange & vbCrLf
    Err.Clear
    ' Select the range then copy it.

    On Error GoTo 0
    Range(ExcelSlide).Worksheet.Activate
    ActiveSheet.ChartObjects(strRange).Activate
    ActiveChart.ChartArea.Copy
    Range("A1").Select

    ' Paste the range

    Set shShape = oPPTApp.ActivePresentation.Slides(intSlideNum).Shapes.PasteSpecial(ppPasteEnhancedMetafile)

    ''    oPPTApp.Run ("ResizeShapeSize")

    ' Align the pasted range

    With shShape
        .LockAspectRatio = 0
        .Left = intLeft
        .Top = intTop
        .Width = intWidth
        .Height = intHeight
        .Name = "ExcelSlide_" & strRange
    End With


End Function
Sub delPPTShapesActiveSlide()    'deletes inserted objects that where inserted previously by macro
    Dim oPPTApp As Object
    Dim oPPTFile As Object
    Dim oPPTSlide As Object
    Dim i As Long
    Set oPPTApp = GetObject(, "Powerpoint.Application")
    Set oPPTFile = oPPTApp.ActivePresentation
    oPPTApp.ActiveWindow.ViewType = 1
    For Each oPPTSlide In oPPTFile.Slides
        If oPPTSlide.SlideIndex > 3 Then
            For i = oPPTSlide.Shapes.Count To 1 Step -1
                If oPPTSlide.Shapes(i).Name Like "ExcelSlide_*" Then oPPTSlide.Shapes(i).Delete
            Next i
        End If
    Next oPPTSlide

    oPPTApp.ActiveWindow.ViewType = ppViewNormal
    Set oPPTApp = Nothing
    Set oPPTFile = Nothing
    Set oPPTSlide = Nothing
End Sub

Open in new window




Thanks,
Montrof
0
Comment
Question by:montrof
  • 2
  • 2
5 Comments
 
LVL 48

Expert Comment

by:Rgonzo1971
Comment Utility
Hi,

in XL you have to define all your PPT values

like

Const ppPasteEnhancedMetafile = 2
Const ppViewNormal = 9


Regards
0
 
LVL 23

Accepted Solution

by:
JSRWilson earned 500 total points
Comment Utility
@ Rgonzo

The poster clearly has created a reference to PPT code with early binding so the PPT values would work fine.

@montrof

Without seeing the Excel file it is very difficult to unravel your code. Are you sure whatever you copies can be pasted as an EMF?? If you paste special each of the items manually is EMF one of the options.

There are also errors in your code:

There'a a rogue period and no wsProtection sub routine. I guess these are typos.

More important :

PasteSpecial always returns a ShapeRange NOT a Shape. You have declared  shShape as an object which works but treated it as a shape. 2010 will tolerate this even though it is incorrect. I think 2013 will require you to use it correctly, ie Shapes(1) in the Range

    With shShape(1)
        .LockAspectRatio = 0
        .Left = intLeft
        .Top = intTop
        .Width = intWidth
        .Height = intHeight
        .Name = "ExcelSlide_" & strRange
    End With
0
 
LVL 1

Author Comment

by:montrof
Comment Utility
@JSRWilson Thank you for the response, I am able to paste with EMF option manually also the code runs without a problem in 2007.  

Thanks,
Montrof
0
 
LVL 23

Expert Comment

by:JSRWilson
Comment Utility
So did you read my comment about Shaperanges??
0
 
LVL 1

Author Closing Comment

by:montrof
Comment Utility
Thanks for the help
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

No matter the version of Windows you are using, you may have some problems with Windows Search running too slow or possibly not running at all. Before jumping into how you can solve this issue, just know there are many other viable alternative deskt…
Many programs have tried to outwit PowerPoint in terms of technology and skill. These programs, however, still lack several characteristics that PowerPoint has possessed from the start. Here's why PowerPoint replacements won't entirely work for desi…
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now