Solved

How can I specify the exact location of the ranges and charts, which should be copied using a macro from excel to ppt?

Posted on 2011-03-14
4
418 Views
Last Modified: 2012-05-11
Hi guys,

I am new to this forum and would reaaaaaally appreciate any help on this matter:

I need to copy a lot of ranges and charts from excel to ppt. I found a macro which does that for me (http://www.ehow.com/how_5551671_automatically-powerpoint-using-vba-macro.html) but I have one problem - I don´t understand how the numbers for the position of the ranges are computed. Let´s say I need to have diff. ranges on one slide on exact positions, but when I try to "guess" the right numbers in vba, I get totally different position in powerpoint.

 How can I figure out which numbers for the coordinates to use in vba, if I know the exact position I wanna have in powerpoint? The same question goes for the sizing of the ranges and charts which I need to copy.

You could save me a lot of time with this and any help is appreciated. See the code in attachment.

Thanx a lot in advance!
First module:

Public Function copy_chart(sheet, chart_name, slide, awidth, aheight, atop, aleft)

Sheets(sheet).Select

' Set a VBE reference to Microsoft PowerPoint Object Library

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.slide


' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
PPApp.ActiveWindow.View.GotoSlide (slide)
' Reference active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

ActiveSheet.ChartObjects(chart_name).Activate
ActiveChart.ChartArea.Copy

PPSlide.Select
PPSlide.Shapes.PasteSpecial ppPastePNG
PPSlide.Select
PPSlide.Shapes(PPSlide.Shapes.Count).Select

Dim sr As PowerPoint.ShapeRange
Set sr = PPApp.ActiveWindow.Selection.ShapeRange

' Resize:
sr.Width = awidth
sr.Height = aheight

If sr.Width > 700 Then
sr.Width = 700
End If
If sr.Height > 420 Then
sr.Height = 420
End If
' Realign:
sr.Align msoAlignCenters, True
sr.Align msoAlignMiddles, True
sr.Top = atop

If aleft <> 0 Then
sr.Left = aleft
End If

Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Function

Public Function copy_range(sheet, rowStart, columnStart, row_count, columnCount, slide, aheight, awidth, atop, aleft)

Sheets(sheet).Select
Cells(rowStart, columnStart).Resize(row_count, columnCount).Select

' Make sure a range is selected
If Not TypeName(Selection) = "Range" Then
MsgBox "Please select a worksheet range and try again.", vbExclamation, _
"No Range Selected"
Else

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
PPApp.ActiveWindow.View.GotoSlide (slide)
' Reference active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

' Copy the range as a picture
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap

' Paste the range
PPSlide.Shapes.Paste.Select

Dim sr As PowerPoint.ShapeRange
Set sr = PPApp.ActiveWindow.Selection.ShapeRange

' Resize:
sr.Width = awidth
sr.Height = aheight

If sr.Width > 700 Then
sr.Width = 700
End If
If sr.Height > 420 Then
sr.Height = 420
End If
' Realign:
sr.Align msoAlignCenters, True
sr.Align msoAlignMiddles, True
sr.Top = atop

If aleft <> 0 Then
sr.Left = aleft
End If

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End If

End Function

Public Function copy_text(sheet, rowStart, columnStart, row_count, columnCount, slide, textbox)

Sheets(sheet).Select
Text = Cells(rowStart, columnStart).Resize(row_count, columnCount).Text


' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
PPApp.ActiveWindow.View.GotoSlide (slide)
' Reference active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

PPSlide.Shapes(textbox).TextFrame.TextRange = Text


' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Function

Public Function add_slide()

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
'create new slide
PPApp.Activate
PPPres.Slides.AddSlide PPPres.Slides.Count + 1, PPPres.SlideMaster.CustomLayouts(2)

End Function


Second module:

Sub makePowerPoint()
Dim PPT As PowerPoint.Application
Set PPT = New PowerPoint.Application
PPT.Visible = True
PPT.Presentations.Open Filename:="C:xxx.pptm"

add_slide

'' Slide 1 ''
copy_range "ValueSheetEU&CIS", 3, 2, 6, 9, 1, 96, 25, 50, 37

add_slide

'' Slide 2 ''
copy_range "ValueSheetEU&CIS", 6, 2, 13, 4, 2, 200, 90, 60, 15
copy_range "ValueSheetEU&CIS", 6, 7, 13, 4, 2, 200, 90, 60, 360
copy_range "ValueSheetEU&CIS", 21, 2, 14, 4, 2, 215, 105, 275, 15
copy_range "ValueSheetEU&CIS", 21, 7, 13, 4, 2, 200, 90, 275, 360


End Sub

Open in new window

0
Comment
Question by:Vivaldinho
  • 2
4 Comments
 
LVL 19

Accepted Solution

by:
akoster earned 125 total points
ID: 35129564
The tops, lefts, widths en heights are measured in points (data type single, so 5.1 points is possible)
You can use the following function to convert from inches to points :
InchesToPoints

eg to place a chart 1 inch from the top :
sr.Top = Application.InchesToPoints(1)

Open in new window

0
 
LVL 19

Expert Comment

by:akoster
ID: 35129586
Or, use :

CentimetersToPoints for centimeters instead of inches.

in general : 1 point =  1/72 inch = 1/28 cm
0
 
LVL 24

Expert Comment

by:broomee9
ID: 35360837
This question has been classified as abandoned and is being closed as part of the Cleanup Program. See my comment at the end of the question for more details.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

What is a Form List Box? (skip if you know this) The forms List Box is the alternative to the ActiveX list box. If you are using excel 2007, you first make sure you have a developer tab (click the Orb)->"Excel Options"->Popular->"Show Developer tab…
INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now