Solved

Multiple excel tab ranges to powerpoint slides

Posted on 2013-12-06
14
1,281 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
Are your AD admin tools letting you down?

Managing Active Directory can get complicated.  Often, the native tools for managing AD are just not up to the task.  The largest Active Directory installations in the world have relied on one tool to manage their day-to-day administration tasks: Hyena. Start your trial today.

 
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

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

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

PowerPoint is the go-to presentation software for millions of users around the world. Many presentations use basic text features but you can really make special text jump out of your slide by applying this bubble text design process. This article ha…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

777 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