• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 447
  • Last Modified:

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

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
Vivaldinho
Asked:
Vivaldinho
  • 2
1 Solution
 
Arno KosterCommented:
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
 
Arno KosterCommented:
Or, use :

CentimetersToPoints for centimeters instead of inches.

in general : 1 point =  1/72 inch = 1/28 cm
0
 
TracyVBA DeveloperCommented:
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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now