Link to home
Start Free TrialLog in
Avatar of dbfc
dbfcFlag for United States of America

asked on

what is the vba command for "Paste Special Microsoft Visio Drawing Object" Using PowerPoint 2010

I am attempting to write a Macro in PowerPoint 2010 that allows me to Paste Special a selected Microsoft Visio Drawing Object.  I have been unable to find the VBA command that simulates this option available in the Paste Special.
Avatar of Rgonzo1971
Rgonzo1971

Hi,

pls try

ActiveWindow.View.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse

Regards
Avatar of dbfc

ASKER

Already tried...does not provide the same result as  Paste Special "Microsoft Visio Drawing Object" available from the Paste Special options.
Pls try to record the same action in Excel

Then we will be able to adapt it to PPT

You should get something like this (I suppose)

ActiveSheet.PasteSpecial Format:="Microsoft Visio Document" _
        , Link:=False, DisplayAsIcon:=False

Regards
ASKER CERTIFIED SOLUTION
Avatar of dbfc
dbfc
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
This might help too. EMF objects can be usefully converted to native Microsoft Drawing objects which can then be edited in PowerPoint (and other MSO apps).

' =====================================================================
' Macro written by Jamie Garroch of http://youpresent.biz
' =====================================================================
' Pastes a vector based object from the clipboard to the current slide,
' converts it to a native MS Drawing objetc and then ungroups it to
' individual shapes.
' =====================================================================
' Function Parameters
'
'   Convert = True will convert the pasted object to an MS Drawing
'             object and then ungroup it to its component shapes
' =====================================================================
' Function Return : the pasted ShapeRange
' =====================================================================

Option Explicit

Public Function PasteEMFtoSlideShapes(Optional Convert As Boolean) As ShapeRange
  On Error GoTo errorhandler
  Dim oShpRng As ShapeRange
  
  ' Paste the clipboard object as a vector in EMF format
  Set oShpRng = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex).Shapes.PasteSpecial(ppPasteEnhancedMetafile, msoFalse)
  If Convert Then
    With oShpRng(1)
      ' Ungroup to convert to Microsoft Drawing Object
      .Ungroup.Select
      ' Now ungroup a second time to get the component shapes
      ActiveWindow.Selection.ShapeRange.Ungroup
    End With
  End If
  
  Set PasteEMFtoSlideShapes = oShpRng
  
  ' Clean up
  Set oShpRng = Nothing
Exit Function

errorhandler:
  MsgBox "An error occured:" & vbCrLf & vbCrLf & Err & " : " & Err.Description, vbCritical + vbOK, "VBA Macro Error"
  Err.Clear
  Set oShpRng = Nothing
End Function

Open in new window

Avatar of dbfc

ASKER

It was the easiest solution to implement.