Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

VBA Works in Excel 2007 Not in 2013 Copy to PPT

Posted on 2013-12-04
5
Medium Priority
?
1,949 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 53

Expert Comment

by:Rgonzo1971
ID: 39697661
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 2000 total points
ID: 39697690
@ 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
ID: 39698048
@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
ID: 39698134
So did you read my comment about Shaperanges??
0
 
LVL 1

Author Closing Comment

by:montrof
ID: 39698344
Thanks for the help
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

618 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