CMekae
06-27-2016, 12:19 PM
Attempting to automate regular reporting. Have written macros to export content from Excel and place into slideshow, but am having trouble applying custom slide layouts that I have created in the PowerPoint template. The code below inserts a new slide into the deck, but I cannot figure out how to apply one of the 4 slide layouts I have created (see image below). PLEASE NOTE that I have written this code in Excel VBA...
16487
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.ActiveWindow.ViewType = 1
PPT.ActivePresentation.Slides.Add PPT.ActivePresentation.Slides.Count + 1, Layout:=ActivePresentation.SlideMaster.CustomLayouts(2)
PPT.ActiveWindow.View.GotoSlide PPT.ActivePresentation.Slides.Count
Paul_Hossler
06-27-2016, 12:50 PM
This might get you started.
This is some PP code that assigns a custom layout in the slide master to a slide
For some reason known only to Microsoft, you can't use the .Name to index into the collection, so that's the reason for the For/Next
Option Explicit
Sub test()
Dim oSlide As Slide
Dim oDMATitle As CustomLayout, oDMA1 As CustomLayout, oDMA2 As CustomLayout, oDMA3 As CustomLayout
Dim i As Long
With ActivePresentation
For i = 1 To .SlideMaster.CustomLayouts.Count
If .SlideMaster.CustomLayouts(i).Name = "DMA_Title" Then
Set oDMATitle = .SlideMaster.CustomLayouts(i)
ElseIf .SlideMaster.CustomLayouts(i).Name = "DMA1" Then
Set oDMA1 = .SlideMaster.CustomLayouts(i)
ElseIf .SlideMaster.CustomLayouts(i).Name = "DMA2" Then
Set oDMA2 = .SlideMaster.CustomLayouts(i)
ElseIf .SlideMaster.CustomLayouts(i).Name = "DMA3" Then
Set oDMA3 = .SlideMaster.CustomLayouts(i)
End If
Next I
Set oSlide = .Slides(1)
oSlide.CustomLayout = oDMATitle
End With
End Sub
CMekae
06-27-2016, 01:03 PM
What is your macro "Test" doing? I am teaching myself VBA right now so bare with my notes throughout the code (I appreciate your patience). Currently, I have this setup so that it will create 1 slide at a time out of a group of 3 slides, for which that process will be looped around 70 times. Everything I try is giving me error '429' ActiveX component cant create object. Here is the entire code I've written so far.
Sub ButtonControl()
'Allows button on "Graphs" sheet to run entire Export Cycle
Call DMA_Loop
End Sub
Sub DMA_Loop() 'This macro loops allows the program to repeat the export cycle for each DMA
Dim DMA_List As Range
Dim DMA_Name As Range
'Allows VBA to read dropdown list as a range
Set DMA_List = Evaluate(Sheets("Working").Range("B3").Validation.Formula1)
'Gives each DMA its own unique variable name
For Each DMA_Name In DMA_List
Sheets("Working").Range("B3").Value = DMA_Name.Value
'Jumps down into slide export cycle
Call ExportCycle1
'"= False" saves memory and time throughout program
Application.ScreenUpdating = False
'Once export cycle is complete this moves program onto the next DMA
Next DMA_Name
End Sub
Sub ExportCycle1() 'This macro creates the first slide (1 of 3) in the deck for each DMA
'"= False" optimizes code, saves memory, and time throughout program
Application.ScreenUpdating = False
Sheets("Graphs").Activate
'Adds first slide to deck for each DMA
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.ActiveWindow.ViewType = 1
PPT.ActivePresentation.Slides.Add PPT.ActivePresentation.Slides.Count + 1, Layout:=ActivePresentation.SlideMaster.CustomLayouts(2)
PPT.ActiveWindow.View.GotoSlide PPT.ActivePresentation.Slides.Count
'Copy/Paste/Locate/Resize "B&M Market Share Chart"
Sheets("Graphs").ChartObjects("Market Share B&M").Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 380
PPT.ActiveWindow.Selection.ShapeRange.Top = 80
PPT.ActiveWindow.Selection.ShapeRange.Height = 192.2
PPT.ActiveWindow.Selection.ShapeRange.Width = 321
'Copy/Paste/Locate/Resize "B&M YoY Growth Chart"
Sheets("Graphs").ChartObjects("YoY B&M").Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 380
PPT.ActiveWindow.Selection.ShapeRange.Top = 287
PPT.ActiveWindow.Selection.ShapeRange.Height = 192.2
PPT.ActiveWindow.Selection.ShapeRange.Width = 321
'Copy "B&M Market Summary Chart"
Sheets("Graphs").Range("AB55:AG63").Select
Selection.Copy
'Creates an image of the chart range (stored in spreadsheet)
Range("AB66").Select
ActiveSheet.Pictures.Paste.Select
'Copy/Paste/Locate/Resize "B&M Market Summary Chart"
ActiveSheet.Pictures.Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 17.6
PPT.ActiveWindow.Selection.ShapeRange.Top = 80
PPT.ActiveWindow.Selection.ShapeRange.Height = 91
PPT.ActiveWindow.Selection.ShapeRange.Width = 353.5
'Erases the chart image created in the previous step, so that the next DMA in the cycle can use cell "AB66" to store the image
Call DeleteImage
'Macro for second slide in the Export Cycle
Call ExportCycle2
'Macro for third slide in the Export Cycle
Call ExportCycle3
End Sub
Sub ExportCycle2()
'"= False" optimizes code, saves memory, and time throughout program
Application.ScreenUpdating = False
'Adds second slide to deck for each DMA
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.ActiveWindow.ViewType = 1
PPT.ActivePresentation.Slides.Add PPT.ActivePresentation.Slides.Count + 1, Layout:=ActivePresentation.SlideMaster.CustomLayouts(3)
PPT.ActiveWindow.View.GotoSlide PPT.ActivePresentation.Slides.Count
'Copy/Paste/Locate/Resize "ECOM Market Share Chart"
Sheets("Graphs").ChartObjects("Market Share Online").Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 35.5
PPT.ActiveWindow.Selection.ShapeRange.Top = 275
PPT.ActiveWindow.Selection.ShapeRange.Height = 194
PPT.ActiveWindow.Selection.ShapeRange.Width = 323
'Copy/Paste/Locate/Resize "ECOM YoY Growth Chart"
Sheets("Graphs").ChartObjects("YoY Online").Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 365
PPT.ActiveWindow.Selection.ShapeRange.Top = 275
PPT.ActiveWindow.Selection.ShapeRange.Height = 194
PPT.ActiveWindow.Selection.ShapeRange.Width = 323
'"= False" optimizes code, saves memory, and time throughout program
Application.ScreenUpdating = False
End Sub
Sub ExportCycle3()
'"= False" optimizes code, saves memory, and time throughout program
Application.ScreenUpdating = False
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
'Add third slide to deck for each DMA
PPT.ActiveWindow.ViewType = 1
PPT.ActivePresentation.Slides.Add PPT.ActivePresentation.Slides.Count + 1, Layout:=ActivePresentation.SlideMaster.CustomLayouts(4)
PPT.ActiveWindow.View.GotoSlide PPT.ActivePresentation.Slides.Count
'Copy "Quarterly B&M Market Share Sparklines Chart"
Sheets("Graphs").Range("T8:Z26").Select
Selection.Copy
'Creates an image of the chart range (stored in spreadsheet)
Range("AB8").Select
ActiveSheet.Pictures.Paste.Select
'Copy/Paste/Locate/Resize "Quarterly B&M Market Share Sparklines Chart"
ActiveSheet.Pictures.Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 35
PPT.ActiveWindow.Selection.ShapeRange.Top = 105
PPT.ActiveWindow.Selection.ShapeRange.Height = 309
PPT.ActiveWindow.Selection.ShapeRange.Width = 320.5
'"= False" optimizes code, saves memory, and time throughout program
Application.ScreenUpdating = False
'Erases the chart image created in the previous step, so that the next DMA in the cycle can use cell "AB8" to store the image
Call DeleteImage
'Copy "Quarterly ECOM Market Share Sparklines Chart"
Sheets("Graphs").Range("T33:Z50").Select
Selection.Copy
'Creates an image of the chart range (stored in spreadsheet)
Range("AB33").Select
ActiveSheet.Pictures.Paste.Select
'Copy/Paste/Locate/Resize "Quarterly B&M Market Share Sparklines Chart"
ActiveSheet.Pictures.Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 360
PPT.ActiveWindow.Selection.ShapeRange.Top = 105
PPT.ActiveWindow.Selection.ShapeRange.Height = 296
PPT.ActiveWindow.Selection.ShapeRange.Width = 320.5
'"= False" optimizes code, saves memory, and time throughout program
Application.ScreenUpdating = False
'Erases the chart image created in the previous step, so that the next DMA in the cycle can use cell "AB8" to store the image
Call DeleteImage
End Sub
Sub DeleteImage() 'Removes pictures of the charts from spreadsheet created in subs ExportCycle1 & ExportCycle3
Sheets("Graphs").Activate
ActiveSheet.Pictures.Select
Selection.Delete
End Sub
Paul_Hossler
06-27-2016, 01:54 PM
but I cannot figure out how to apply one of the 4 slide layouts I have created
The macro Test just looks for each of the 4 custom slide layouts in Master and Sets a object variable to each
I only used a single slide in my presentation, and applied one of the 4 custom layouts to that slide
CMekae
06-27-2016, 01:56 PM
Paul - How would that fit into the code that I have written so far?
Paul_Hossler
06-28-2016, 06:40 AM
Not tested, but some thoughts, since I didn't have the Excel and Powerpoint files
The code can be simplified a lot, but I THINK that
1. The err 429 was because you kept creating a PP object. I believe only one time is sufficient
2. Assumes that the 4 DMAx custom layouts are n the slide master for the PP presentation that is open
3. I marked some lines with ------------------------------ as highlight
3. Instead of chaining Export2 to Export1 and Export3 to Export2, I moved them inside the loop
Option Explicit
'module level - can be used by anything in this module------------------------------
Dim oDMATitle As Object, oDMA1 As Object, oDMA2 As Object, oDMA3 As Object
Dim PPT As Object
Sub Init()
'only create once --------------------------------------------------------
Set PPT = CreateObject("PowerPoint.Application")
Dim i As Long
With PPT.ActivePresentation
For i = 1 To .SlideMaster.CustomLayouts.Count
If .SlideMaster.CustomLayouts(i).Name = "DMA_Title" Then
Set oDMATitle = .SlideMaster.CustomLayouts(i)
ElseIf .SlideMaster.CustomLayouts(i).Name = "DMA1" Then
Set oDMA1 = .SlideMaster.CustomLayouts(i)
ElseIf .SlideMaster.CustomLayouts(i).Name = "DMA2" Then
Set oDMA2 = .SlideMaster.CustomLayouts(i)
ElseIf .SlideMaster.CustomLayouts(i).Name = "DMA3" Then
Set oDMA3 = .SlideMaster.CustomLayouts(i)
End If
Next i
End With
'only needs to be set one time ------------------------------------------------------
'"= False" optimizes code, saves memory, and time throughout program
Application.ScreenUpdating = False
End Sub
Sub ButtonControl()
'Allows button on "Graphs" sheet to run entire Export Cycle
Call Init '--------------------------------------------------------------------
Call DMA_Loop
End Sub
Sub DMA_Loop() 'This macro loops allows the program to repeat the export cycle for each DMA
Dim DMA_List As Range
Dim DMA_Name As Range
'Allows VBA to read dropdown list as a range
Set DMA_List = Evaluate(Sheets("Working").Range("B3").Validation.Formula1)
'Gives each DMA its own unique variable name
For Each DMA_Name In DMA_List
Sheets("Working").Range("B3").Value = DMA_Name.Value
'Jumps down into slide export cycle
Call ExportCycle1
'Macro for second slide in the Export Cycle------------------------------------------------------------------------
Call ExportCycle2
'Macro for third slide in the Export Cycle----------------------------------------------------------------------------
Call ExportCycle3
'Once export cycle is complete this moves program onto the next DMA
Next DMA_Name
End Sub
Sub ExportCycle1() 'This macro creates the first slide (1 of 3) in the deck for each DMA
Sheets("Graphs").Activate
'Adds first slide to deck for each DMA
PPT.ActiveWindow.ViewType = 1
' PPT.ActivePresentation.Slides.Add PPT.ActivePresentation.Slides.Count + 1, Layout:=ActivePresentation.SlideMaster.CustomLayouts(2)
PPT.ActivePresentation.Slides.Add PPT.ActivePresentation.Slides.Count + 1, customLayout:=oDMA1 '--------------------------------------------------------
PPT.ActiveWindow.View.GotoSlide PPT.ActivePresentation.Slides.Count
'Copy/Paste/Locate/Resize "B&M Market Share Chart"
Sheets("Graphs").ChartObjects("Market Share B&M").Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 380
PPT.ActiveWindow.Selection.ShapeRange.Top = 80
PPT.ActiveWindow.Selection.ShapeRange.Height = 192.2
PPT.ActiveWindow.Selection.ShapeRange.Width = 321
'Copy/Paste/Locate/Resize "B&M YoY Growth Chart"
Sheets("Graphs").ChartObjects("YoY B&M").Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 380
PPT.ActiveWindow.Selection.ShapeRange.Top = 287
PPT.ActiveWindow.Selection.ShapeRange.Height = 192.2
PPT.ActiveWindow.Selection.ShapeRange.Width = 321
'Copy "B&M Market Summary Chart"
Sheets("Graphs").Range("AB55:AG63").Select
Selection.Copy
'Creates an image of the chart range (stored in spreadsheet)
Range("AB66").Select
ActiveSheet.Pictures.Paste.Select
'Copy/Paste/Locate/Resize "B&M Market Summary Chart"
ActiveSheet.Pictures.Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 17.6
PPT.ActiveWindow.Selection.ShapeRange.Top = 80
PPT.ActiveWindow.Selection.ShapeRange.Height = 91
PPT.ActiveWindow.Selection.ShapeRange.Width = 353.5
'Erases the chart image created in the previous step, so that the next DMA in the cycle can use cell "AB66" to store the image
Call DeleteImage
End Sub
Sub ExportCycle2()
PPT.ActiveWindow.ViewType = 1
PPT.ActivePresentation.Slides.Add PPT.ActivePresentation.Slides.Count + 1, customLayout:=oDMA2
PPT.ActiveWindow.View.GotoSlide PPT.ActivePresentation.Slides.Count
'Copy/Paste/Locate/Resize "ECOM Market Share Chart"
Sheets("Graphs").ChartObjects("Market Share Online").Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 35.5
PPT.ActiveWindow.Selection.ShapeRange.Top = 275
PPT.ActiveWindow.Selection.ShapeRange.Height = 194
PPT.ActiveWindow.Selection.ShapeRange.Width = 323
'Copy/Paste/Locate/Resize "ECOM YoY Growth Chart"
Sheets("Graphs").ChartObjects("YoY Online").Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 365
PPT.ActiveWindow.Selection.ShapeRange.Top = 275
PPT.ActiveWindow.Selection.ShapeRange.Height = 194
PPT.ActiveWindow.Selection.ShapeRange.Width = 323
End Sub
Sub ExportCycle3()
'Add third slide to deck for each DMA
PPT.ActiveWindow.ViewType = 1
PPT.ActivePresentation.Slides.Add PPT.ActivePresentation.Slides.Count + 1, customLayout:=oDMA3
PPT.ActiveWindow.View.GotoSlide PPT.ActivePresentation.Slides.Count
'Copy "Quarterly B&M Market Share Sparklines Chart"
Sheets("Graphs").Range("T8:Z26").Select
Selection.Copy
'Creates an image of the chart range (stored in spreadsheet)
Range("AB8").Select
ActiveSheet.Pictures.Paste.Select
'Copy/Paste/Locate/Resize "Quarterly B&M Market Share Sparklines Chart"
ActiveSheet.Pictures.Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 35
PPT.ActiveWindow.Selection.ShapeRange.Top = 105
PPT.ActiveWindow.Selection.ShapeRange.Height = 309
PPT.ActiveWindow.Selection.ShapeRange.Width = 320.5
'Erases the chart image created in the previous step, so that the next DMA in the cycle can use cell "AB8" to store the image
Call DeleteImage
'Copy "Quarterly ECOM Market Share Sparklines Chart"
Sheets("Graphs").Range("T33:Z50").Select
Selection.Copy
'Creates an image of the chart range (stored in spreadsheet)
Range("AB33").Select
ActiveSheet.Pictures.Paste.Select
'Copy/Paste/Locate/Resize "Quarterly B&M Market Share Sparklines Chart"
ActiveSheet.Pictures.Copy
PPT.ActiveWindow.View.PasteSpecial (6) '(6) = paste as image
PPT.ActiveWindow.Selection.ShapeRange.Left = 360
PPT.ActiveWindow.Selection.ShapeRange.Top = 105
PPT.ActiveWindow.Selection.ShapeRange.Height = 296
PPT.ActiveWindow.Selection.ShapeRange.Width = 320.5
'Erases the chart image created in the previous step, so that the next DMA in the cycle can use cell "AB8" to store the image
Call DeleteImage
End Sub
Sub DeleteImage() 'Removes pictures of the charts from spreadsheet created in subs ExportCycle1 & ExportCycle3
Sheets("Graphs").Activate
ActiveSheet.Pictures.Select
Selection.Delete
End Sub
CMekae
06-28-2016, 08:01 AM
That code works perfectly to export but does not apply the slide layouts to each slide. Any ideas as to why?
That being said, I was able to adapt the code you gave me yesterday by putting it into the PowerPoint template and running it separately after exporting from Excel (see code below). Out of curiosity, how would you take what I wrote and replace the sliderange arrays with a formula turning the starting slides into variables (slides 2-4 into x,y,z?) and adding 3 slides to the starting variable then looping that process???
Option Explicit
Sub ApplyLayouts()
Dim DMA_Slide As SlideRange
Dim DMATitle As CustomLayout, DMA1 As CustomLayout, DMA2 As CustomLayout, DMA3 As CustomLayout
Dim x As Long
With ActivePresentation
For x = 1 To .SlideMaster.CustomLayouts.Count
If .SlideMaster.CustomLayouts(x).Name = "DMA_Title" Then
Set DMATitle = .SlideMaster.CustomLayouts(x)
ElseIf .SlideMaster.CustomLayouts(x).Name = "DMA1" Then
Set DMA1 = .SlideMaster.CustomLayouts(x)
ElseIf .SlideMaster.CustomLayouts(x).Name = "DMA2" Then
Set DMA2 = .SlideMaster.CustomLayouts(x)
ElseIf .SlideMaster.CustomLayouts(x).Name = "DMA3" Then
Set DMA3 = .SlideMaster.CustomLayouts(x)
End If
Next x
Set DMA_Slide = .Slides.Range(Array(2, 5, 8, 11, 14, 17, 20, 23, 26, 29, 32, 35, 38, 41, 44, 47, 50, 53, 56, 59, 62, 65, 68, 71, 74, 77, 80, 83, 86, 89, 92))
DMA_Slide.CustomLayout = DMA1
Set DMA_Slide = .Slides.Range(Array(3, 6, 9, 12, 15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57, 60, 63, 66, 69, 72, 75, 78, 81, 84, 87, 90, 93))
DMA_Slide.CustomLayout = DMA2
Set DMA_Slide = .Slides.Range(Array(4, 7, 10, 13, 16, 19, 22, 25, 28, 31, 34, 37, 40, 43, 46, 49, 52, 55, 58, 61, 64, 67, 70, 73, 76, 79, 82, 85, 88, 91, 94))
DMA_Slide.CustomLayout = DMA3
End With
End Sub
Paul_Hossler
06-28-2016, 12:39 PM
For I = 2 to ActivePresentation.Slides.Count
Select case I mod 3
Case 0
ActivePresentation.Slides(I).CustomLayout = DMA2
Case 1
ActivePresentation.Slides(I).CustomLayout = DMA3
Case 2
ActivePresentation.Slides(I).CustomLayout = DMA1
End Select
Next i
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.