My Assistant
![]() ![]() |
|
|
Mar 21 2012, 12:06 PM
Post
#1
|
|
|
UtterAccess Addict Posts: 279 From: Yanbu Al Bahr, Kingdom of Saudi Arabia |
Dear Gentlemen,
I have found some vba at the net to automatically create a power point from excel. The vba code is running perfectly. However, I want to open this into our company ppt template. Can anybody please take a look at the visual basic application in which logic need to edit/add the principle as am not expert of this method. Your kind support will be highly appreciated. Best Regards, Little Nathan CODE Sub CreatePowerPoint() 'Add a reference to the Microsoft PowerPoint Library by: '1. Go to Tools in the VBA menu '2. Click on Reference '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay 'First we declare the variables we will be using Dim newPowerPoint As PowerPoint.Application Dim activeSlide As PowerPoint.Slide Dim cht As Excel.ChartObject 'Look for existing instance On Error Resume Next Set newPowerPoint = GetObject(, "PowerPoint.Application") On Error GoTo 0 'Let's create a new PowerPoint If newPowerPoint Is Nothing Then Set newPowerPoint = New PowerPoint.Application End If 'Make a presentation in PowerPoint If newPowerPoint.Presentations.Count = 0 Then newPowerPoint.Presentations.Add End If 'Show the PowerPoint newPowerPoint.Visible = True 'Loop through each chart in the Excel worksheet and paste them into the PowerPoint For Each cht In ActiveSheet.ChartObjects 'Add a new slide where we will paste the chart newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count) 'Copy the chart and paste it into the PowerPoint as a Metafile Picture cht.Select ActiveChart.ChartArea.Copy activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select 'Set the title of the slide the same as the title of the chart activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text 'Adjust the positioning of the Chart on Powerpoint Slide newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15 newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125 activeSlide.Shapes(2).Width = 200 activeSlide.Shapes(2).Left = 505 'If the chart is the "US" consumption chart, then enter the appropriate comments If InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text, "US") Then activeSlide.Shapes(2).TextFrame.TextRange.Text = Range("J7").Value & vbNewLine activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J8").Value & vbNewLine) 'Else if the chart is the "Renewable" consumption chart, then enter the appropriate comments ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text, "Renewable") Then activeSlide.Shapes(2).TextFrame.TextRange.Text = Range("J27").Value & vbNewLine activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J28").Value & vbNewLine) activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J29").Value & vbNewLine) End If 'Now let's change the font size of the callouts box activeSlide.Shapes(2).TextFrame.TextRange.Font.Size = 16 Next AppActivate ("Microsoft PowerPoint") Set activeSlide = Nothing Set newPowerPoint = Nothing End Sub |
|
|
|
Mar 27 2012, 01:18 AM
Post
#2
|
|
|
UtterAccess VIP Posts: 20,228 From: Colorado |
Hi Nathan,
from Help: CODE Application.ActivePresentation.ApplyTemplate _ "c:\program files\microsoft office\templates\presentation designs\professional.pot" WHERE Application in your code is --> newPowerPoint you can apply the template anytime ... maybe just before your AppActivate statement |
|
|
|
Mar 27 2012, 01:25 PM
Post
#3
|
|
|
UtterAccess Addict Posts: 279 From: Yanbu Al Bahr, Kingdom of Saudi Arabia |
Hi Crystal,
Thanks to your response. Apologize for my tardy reply due to some priorities at the office. Let me apply this code tomorrow at the office then keep you posted. My Best Regards, |
|
|
|
Mar 27 2012, 02:30 PM
Post
#4
|
|
|
UtterAccess VIP Posts: 20,228 From: Colorado |
sounds good, Nathan!
|
|
|
|
![]() ![]() |
|
Go to Top · Lo-Fi Version | Time is now: 20th June 2013 - 07:44 AM |