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
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Also, is it worth converting these things to VB.net (I know even less about this than VBA, which is pretty little)?
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top