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

Powerpoint 2007 VBA to paste as enhanced metafile, resized, and placed at specific location

I am pasting Excel tables to Powerpoint 2007 as enhanced metafiles and would like to speed up the process with some VBA code.  The pasted pictures need to be resized to 120% of their original size (or a fixed width could be specified, but the height varies) and need to be placed at a specific location.

I have code to paste as an enhanced metafile (see attached code snippet).  What I need is code to select the object once pasted, resize it, and place it at a specific location.
ActiveWindow.Selection.SlideRange(1).Shapes.PasteSpecial ppPasteEnhancedMetafile

Open in new window

0
marknlynn3
Asked:
marknlynn3
  • 3
  • 2
2 Solutions
 
Antagony1960Commented:
Just a suggestion: have you thought of preparing what you need to do and then recording a Macro (Tools¦Macro¦Record New Macro...), performing the actions manually and then seeing what Powerpoint produces? There's usually some excess chaff which can be removed from the code, but it shouldn't be too difficult to pick out the bits you need.
0
 
marknlynn3Author Commented:
Powerpoint 2007 doesn't have a macro recorder, and that's the only version of Powerpoint I have access to.  Also, I need the code to automatically select the pasted picture or to link that picture to a variable so that I can manipulate it with VBA.  I don't think using the macro recorder would give me any insight into how to do that.
0
 
Antagony1960Commented:
I didn't know MS had dropped macro recording in PP 2007... the b******s! :-D
Luckily for you I have an old machine here with PP 2003 on it so I recorded a macro with it and modified it to suit your requirements. All I had to do was work out how to get the index of the last shape inserted. I haven't been able to test it on 2007 but I see no reason why it wouldn't work.
Sub PasteAndResize()
Dim i As Integer
    ActiveWindow.Selection.SlideRange(1).Shapes.PasteSpecial ppPasteEnhancedMetafile
    'Get the index of last insertion'
    i = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideNumber).Shapes.Count
    'Select the last inserted object'
    ActiveWindow.Selection.SlideRange.Shapes(i).Select
    'Rescale it to 120%'
    With ActiveWindow.Selection.ShapeRange
        .ScaleWidth 1.2, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
    End With
End Sub

Open in new window

0
Get quick recovery of individual SharePoint items

Free tool – Veeam Explorer for Microsoft SharePoint, enables fast, easy restores of SharePoint sites, documents, libraries and lists — all with no agents to manage and no additional licenses to buy.

 
GlennaShawCommented:
Multiple methods are shown on Jon Peltier's site:
http://peltiertech.com/Excel/XL_PPT.html
0
 
marknlynn3Author Commented:
Thanks Antagony1960, the code you provided was very close to what I needed.  I made the following modifications:

I changed ".ScaleWidth 1.2, msoFalse" to ".ScaleWidth 1.2, True" and "ScaleHeight 1.2, msoFalse" to ".ScaleHeight 1.2, True" so that the picture's width and height would be scaled from the picture's original size rather than the picture's current size.  When I ran the code with this parameter set to scale from the picture's current size (msoFalse) the picture ended up being scaled up 44%.  The 20% increase was applied twice.  Setting the parameter to msoTrue fixed this problem.

I also added some code to set the location of the picture.

GlennaShaw, thanks for pointing me to Jon Peltier's site.  This information should prove useful in the future when I have more to to work on increasing the efficiency of our processes.
Sub PasteAndResize()
Dim i As Integer
    ActiveWindow.Selection.SlideRange(1).Shapes.PasteSpecial ppPasteEnhancedMetafile
    'Get the index of last insertion'
    i = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideNumber).Shapes.Count
    'Select the last inserted object'
    ActiveWindow.Selection.SlideRange.Shapes(i).Select
    'Rescale it to 120%'
    With ActiveWindow.Selection.ShapeRange
        .ScaleWidth 1.2, msoTrue, msoScaleFromTopLeft
        .ScaleHeight 1.2, msoTrue, msoScaleFromTopLeft
        .Left = 30.24
        .Top = 340
    End With
End Sub

Open in new window

0
 
marknlynn3Author Commented:
Thanks both for your help.
0

Featured Post

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.

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