VBA Macro for Excel Chart to PowerPoint Broke in 2013 64-Bit (Worked fine in 2010 32-bit)

[SkierGuy]

Hey, everyone!


I create a lot of charts in my job, and I've been using a macro that copies the print area from each sheet into our company's PPT template while also copying the title from A42, subtitle from A43, file path into the top of the notes field, notes typed into A50-A57 into the PPT notes field below the path, and then moves onto the next sheet and does it all over again. It's a HUGE help. I've recently moved from Excel 2010 32 bit to Excel 2013 64 bit, and now the macro doesn't work. Does anyone have a modification that will make this work or another macro that will work for me? THANK YOU!!!!




Sub CC_PPTSlides()


'Do the following:


Set wrkbk = ActiveWorkbook


Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
objPPT.Presentations.Open Filename:="filename
objPPT.ActiveWindow.ViewType = 1 'ppViewSlide
Dim X As Long
Dim Y As Long
Dim wrksht As Worksheet




'Calculate resolution adjustment
'X = -9 '(GetScreenResolution().x2 - GetScreenResolution().x1) / 1280 * -22
'Y = 32 '(GetScreenResolution().y2 - GetScreenResolution().y1) / 1024 * 13




X = (GetScreenResolution().x2 - GetScreenResolution().x1) / 1280 * -9
Y = (GetScreenResolution().y2 - GetScreenResolution().y1) / 1024 * 32




For Each wrksht In wrkbk.Worksheets
wrksht.Activate


Range("a1").Select
If wrksht.Name = "worksheet name" Then GoTo here:
If wrksht.PageSetup.PrintArea = "" Then GoTo there:


previewmode = wrksht.Application.ActiveWindow.View
pregridstate = wrksht.Application.ActiveWindow.DisplayGridlines
wrksht.Application.ActiveWindow.View = xlNormalView
wrksht.Application.ActiveWindow.DisplayGridlines = False


'Copy chart from excel, paste into ppt
wrksht.Range("Print_Area").CopyPicture xlScreen


'objPPT.ActiveWindow.View.Slide.Shapes.Paste.Select
objPPT.ActiveWindow.View.Slide.Shapes.PasteSpecial DataType:=3
objPPT.ActiveWindow.Selection.SlideRange.Shapes(4).Select


'Center and move the pasted charts
With objPPT.ActiveWindow.Selection.ShapeRange
.Align msoAlignCenters, True
.Align msoAlignMiddles, True
.ScaleWidth 1, msoFalse, msoScaleFromMiddle
.ScaleHeight 1, msoFalse, msoScaleFromMiddle
.IncrementLeft X
.IncrementTop Y
End With
slidetitle = wrksht.Range("a42").Value
Subtitle = wrksht.Range("a43").Value
'Add Main Title
objPPT.ActiveWindow.Selection.SlideRange.Shapes(1).Select
With objPPT.ActiveWindow.Selection.TextRange
.Text = UCase(slidetitle)
End With
'Add SubTitle
objPPT.ActiveWindow.Selection.SlideRange.Shapes(2).Select
With objPPT.ActiveWindow.Selection.TextRange
.Text = UCase(Subtitle)
End With


'Add notes
'Set Sl = objPPT.ActivePresentation.Slides(1)
Set Sl = objPPT.ActiveWindow.Selection.SlideRange
If Sl.NotesPage.Shapes.Count = 0 Then 'If no shapes to take Notes then add a shape first
Sl.NotesPage.Shapes.AddShape msoShapeRectangle, 0, 0, 0, 0
sh = Sl.NotesPage.Shapes(1)
With sh.Font
.Name = "Arial"
.Size = 12
End With
sh.TextFrame.TextRange.Text = _
wrkbk.Path & "\" & wrkbk.Name & vbCrLf & _
wrksht.Range("a50").Value & vbCrLf & _
wrksht.Range("a51").Value & vbCrLf & _
wrksht.Range("a52").Value & vbCrLf & _
wrksht.Range("a53").Value & vbCrLf & _
wrksht.Range("a54").Value & vbCrLf & _
wrksht.Range("a55").Value & vbCrLf & _
wrksht.Range("a56").Value & vbCrLf & _
wrksht.Range("a57").Value & vbCrLf & _
Now
Else 'has shapes, so see if they take text
For Each sh In Sl.NotesPage.Shapes
If sh.HasTextFrame Then
sh.TextFrame.TextRange.Text = _
wrkbk.Path & "\" & wrkbk.Name & vbCrLf & _
wrksht.Range("a50").Value & vbCrLf & _
wrksht.Range("a51").Value & vbCrLf & _
wrksht.Range("a52").Value & vbCrLf & _
wrksht.Range("a53").Value & vbCrLf & _
wrksht.Range("a54").Value & vbCrLf & _
wrksht.Range("a55").Value & vbCrLf & _
wrksht.Range("a56").Value & vbCrLf & _
wrksht.Range("a57").Value & vbCrLf & _
Now
With sh.TextFrame.TextRange.Font
.Name = "Arial"
.Size = 12
End With
Exit For
End If
Next sh
End If
wrksht.Application.ActiveWindow.DisplayGridlines = pregridstate
wrksht.Application.ActiveWindow.View = previewmode
If wrksht.Name = wrkbk.Worksheets(wrkbk.Worksheets.Count).Name Then GoTo here:
'Create duplicate slide for next excel chart
'Get the number of slides in the active presentation.
lLastSlide = objPPT.activepresentation.Slides.Count
lLastSlide = lLastSlide + 1
objPPT.activepresentation.Slides.Add lLastSlide, 16
objPPT.ActiveWindow.View.GotoSlide Index:=lLastSlide
there:
Next


here:
End Sub