Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

Multiple excel tab ranges to powerpoint slides

Posted on 2013-12-06
14
1,284 Views
Last Modified: 2013-12-09
I have a macro that does what I want but need to streamline it so if I need to change, for example the width, I only want to change it in one spot versus multiple times.

Partial code:
PPApp.ActiveWindow.View.GotoSlide (26)
Set PPSlide = PPApp.ActiveWindow.View.Slide
        Sheets("Connects_BO").Select
        LockAspectRatio = False
        ActiveSheet.Range(stBO).Copy
         PPSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile).Select
        PPApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
        PPApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 1, False
        PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 1, False
        PPApp.ActiveWindow.Selection.ShapeRange.Width = 713
        PPApp.ActiveWindow.Selection.ShapeRange.Height = 320#
    ' Realign:
        PPApp.ActiveWindow.Selection.ShapeRange.Top = 70
        PPApp.ActiveWindow.Selection.ShapeRange.Left = 4
       
PPApp.ActiveWindow.View.GotoSlide (27)
Set PPSlide = PPApp.ActiveWindow.View.Slide
        Sheets("Hours_BO").Select
        LockAspectRatio = False
        ActiveSheet.Range(stBO).Copy
         PPSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile).Select
        PPApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
        PPApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 1, False
        PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 1, False
        PPApp.ActiveWindow.Selection.ShapeRange.Width = 713
        PPApp.ActiveWindow.Selection.ShapeRange.Height = 320#
    ' Realign:
        PPApp.ActiveWindow.Selection.ShapeRange.Top = 70
        PPApp.ActiveWindow.Selection.ShapeRange.Left = 4
       
PPApp.ActiveWindow.View.GotoSlide (28)
Set PPSlide = PPApp.ActiveWindow.View.Slide
        Sheets("Sat_BO").Select
        LockAspectRatio = False
        ActiveSheet.Range(stBO).Copy
         PPSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile).Select
        PPApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
        PPApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 1, False
        PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 1, False
        PPApp.ActiveWindow.Selection.ShapeRange.Width = 713
        PPApp.ActiveWindow.Selection.ShapeRange.Height = 320#
    ' Realign:
        PPApp.ActiveWindow.Selection.ShapeRange.Top = 70
        PPApp.ActiveWindow.Selection.ShapeRange.Left = 4
0
Comment
Question by:DCUnited
  • 6
  • 4
  • 3
  • +1
14 Comments
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39701687
Something like

Dim slWidth As Integer
Dim slHeight As Integer
Dim slTop As Integer
Dim slLeft As Integer
slWidth = 713
slHeight = 320
slTopDim = 70
slLeft = 4
PPApp.ActiveWindow.View.GotoSlide (26)
Set PPSlide = PPApp.ActiveWindow.View.Slide
        Sheets("Connects_BO").Select
        LockAspectRatio = False
        ActiveSheet.Range(stBO).Copy
         PPSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile).Select
        PPApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
        PPApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 1, False
        PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 1, False
        PPApp.ActiveWindow.Selection.ShapeRange.Width = slWidth
        PPApp.ActiveWindow.Selection.ShapeRange.Height = slHeight
    ' Realign:
        PPApp.ActiveWindow.Selection.ShapeRange.Top = slTop
        PPApp.ActiveWindow.Selection.ShapeRange.Left = slLeft
.
.
and so on
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39701701
DCU,

You could also create a function that does what you want, and just pass it the things that are different. Replace your block with:
        Call XLtoPP(PPApp, PPApp.ActivePresentation.Slides(26), Sheets("Connects_BO").Range(stBO))
        Call XLtoPP(PPApp, PPApp.ActivePresentation.Slides(27), Sheets("Hours_BO").Range(stBO))
        Call XLtoPP(PPApp, PPApp.ActivePresentation.Slides(28), Sheets("Sat_BO").Range(stBO))

Open in new window

Then at the end of the module, paste in the following:
Function XLtoPP(PPApp As PowerPoint.Application, PPSlide As PowerPoint.Slide, XLRg As Range)
    LockAspectRatio = False
    XLRg.Copy
    PPSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile).Select
    PPApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
    PPApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 1, False
    PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 1, False
    PPApp.ActiveWindow.Selection.ShapeRange.Width = 713
    PPApp.ActiveWindow.Selection.ShapeRange.Height = 320#
' Realign:
    PPApp.ActiveWindow.Selection.ShapeRange.Top = 70
    PPApp.ActiveWindow.Selection.ShapeRange.Left = 4
End Function

Open in new window

Then to tweak it, or if there is more you want to add to your process, just change the function.

Matt
0
 

Author Comment

by:DCUnited
ID: 39701755
Matt this looks like what I want, but when the code got to the Function piece I got a Run-time error stating that the shape range's view must be active at the line
PPSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile).Select
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 23

Accepted Solution

by:
JSRWilson earned 188 total points
ID: 39701772
Doesn't this work?

It is nearly always a bad idea to select things in PPT code.

'change values here
Const sngW As Single = 713
Const sngH As Single = 320
Const sngT As Single = 70
Const sngL As Single = 4

Dim ppSlide As Object
Dim pptPaste As Object

Set ppSlide = pptApp.ActivePresentation.Slides(2)
Sheets("Connects_BO").Select
LockAspectRatio = False
ActiveSheet.Range(stBO).Copy
Set pptPaste = ppSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With pptPaste(1)
.Width = sngW
.Height = sngH
.Left = sngL
.Top = sngT
End With
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39701773
Of course, that was poor thinking on my part. Here is the same thing without selecting the area:
Function XLtoPP(PPApp As PowerPoint.Application, PPSlide As PowerPoint.Slide, XLRg As Range)
    LockAspectRatio = False
    XLRg.Copy
    With PPSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.ScaleHeight 1, False
        .ShapeRange.ScaleWidth 1, False
        .ShapeRange.Width = 713
        .ShapeRange.Height = 320#
' Realign:
        .ShapeRange.Top = 70
        .ShapeRange.Left = 4
   End With
End Function

Open in new window

0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39701777
What are scaleHeight / width doing??
0
 

Author Comment

by:DCUnited
ID: 39701818
It didn't like that version either. However I did tweek the other version and got it to work but all it did was save that last slide over and over again on the 1st slide which is my title page and I have it set to slide (2) to start.
0
 

Author Comment

by:DCUnited
ID: 39701820
the ScaleHeight/ScaleWidth was in this horrible designed report when I took it over
0
 

Author Comment

by:DCUnited
ID: 39701841
I was thinking this could be done using With
I get the method or data member not found with the .ShapeRange
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39701880
That's because a ShapeRange doesn't really have .Left property etc Shapes do.

You would need to say .ShapeRange(1) - First shape in the range
(some versions of PPT will accept the incorrect code if only one shape is pasted but others won't and you didn't say which version)

You will see in my code I refer to pptPaste(1) not pptPaste - first shape in the pasted shapes.

Which slide(s) do you want it to paste to??
0
 

Author Comment

by:DCUnited
ID: 39701892
I am using 2007. As far as which slide, it depends on the excel tab. Each tab name will be copied to a specific slide number.
0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39702806
You need to explain a little more than that if you need code to achieve that!
0
 
LVL 35

Assisted Solution

by:mvidas
mvidas earned 187 total points
ID: 39705955
DCU,

Putting together JSRWilson's corrections with my code gives this; give it a shot with the 3 lines I originally gave you to call the function:
Function XLtoPP(PPApp As PowerPoint.Application, PPSlide As PowerPoint.Slide, XLRg As Range)
    Dim PPPaste As Object
    XLRg.Copy
    Set PPPaste = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
    With PPPaste(1).ShapeRange(1)
        .LockAspectRatio = msoFalse
        .ScaleHeight 1, False
        .ScaleWidth 1, False
        .Width = 713
        .Height = 320#
' Realign:
        .Top = 70
        .Left = 4
   End With
End Function

Open in new window

0
 

Author Closing Comment

by:DCUnited
ID: 39706851
I was hoping to do something like a call function like mvidas suggested, but couldn't get it to work. Went back to original plan of action like what JSRWilson provided.
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

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

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
get the ALL CAPITAL words from a cell 4 20
Stop display of alerts in Word via Excel 12 21
EXCEL formula that pulls formatting as well 12 46
Getting rid of #VALUE! 7 23
 Regular Expressions Microsoft Word has sophisticated search tools that can search for patterns. For example if you wanted to search for all UK phone numbers that followed a pattern of five digits, a space and then six digits you can easily do th…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

860 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