Solved

Multiple excel tab ranges to powerpoint slides

Posted on 2013-12-06
14
1,287 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

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.

Question has a verified solution.

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

Preface: When I started this series, I used the term CommandBars because that is the Office Object class that it discusses. Unfortunately, when Microsoft introduced Office 2007, they replaced the standard Commandbar menus with "The Ribbon" and rem…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

685 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