Greetings to one and all,
please provide a vba code for copying text frame from excel and to paste
in bottom of power point slide.
i have macro code in attached note pad in which macro pastes the text frame
on right hand side of slide
but can any one provide code to paste text frame in bottom of slide.
Thanks,
Rekha
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com
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
ModifyChartTitle
'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 80
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, "Other
People") Then
activeSlide.Shapes(2).TextFrame.TextRange.Text =
Range("p5").Value & vbNewLine
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("p6").Value & vbNewLine)
'Else if the chart is the "Renewable" consumption chart, then enter the
appropriate comments
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"Royalty") Then
activeSlide.Shapes(2).TextFrame.TextRange.Text =
Range("P45").Value & vbNewLine
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"Entertainment") Then
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("P85").Value & vbNewLine)
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"Comp") Then
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("P125").Value & vbNewLine)
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"Outside") Then
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("P155").Value & vbNewLine)
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"All Other") Then
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("P195").Value & vbNewLine)
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"Allocation") Then
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("P235").Value & vbNewLine)
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"Allocation") Then
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("P235").Value & vbNewLine)
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"COGS") Then
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("P265").Value & vbNewLine)
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"D&A") Then
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("P305").Value & vbNewLine)
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"Marketing Promotion") Then
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("P345").Value & vbNewLine)
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text,
"Total Expense") Then
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter
(Range("P385").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
