64 Bit Excel 2013 Macro to Make PPT Slide

SkierGuy

New Member
Joined
May 15, 2014
Messages
7
Hey, everyone! New to the boards, but used them for a while - thanks for all the great help!

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. I am in no way wedded to the macro I currently use, but the code is below. 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
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

SkierGuy

New Member
Joined
May 15, 2014
Messages
7
Also, is it worth converting these things to VB.net (I know even less about this than VBA, which is pretty little)?
 

Watch MrExcel Video

Forum statistics

Threads
1,095,382
Messages
5,444,134
Members
405,269
Latest member
Kjtakke

This Week's Hot Topics

Top