Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Multiple excel tab ranges to powerpoint slides

Posted on 2013-12-06
14
Medium Priority
?
1,320 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
[X]
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
  • 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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 23

Accepted Solution

by:
JSRWilson earned 752 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 748 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

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

Question has a verified solution.

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

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
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…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

688 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