将幻灯片上的所有形状保存/导出为矢量文件答案

【问题标题】：Save / Export all Shapes on a slide as Vector Files将幻灯片上的所有形状保存/导出为矢量文件
【发布时间】：2016-02-10 06:09:17
【问题描述】：

我有以下情况：

我需要将所有形状导出为矢量文件。所以我尝试的是依次选择每个形状并将这个选定的形状导出为.emf。不幸的是，它没有成功。

你知道我该如何解决这个问题吗？

真的很好，因为我有大约 280 个对象需要保存

谢谢，最好的，拉尔夫

【问题讨论】：

标签： vba image vector export powerpoint

【解决方案1】：

另一个论坛的用户找到了方法：

http://www.vbaexpress.com/forum/showthread.php?54241-Export-every-shape-image-on-a-slide-as-Vector-file-(EMF)&p=333530#post333530

Sub exporter()Dim folderPath As String 
Dim osld As Slide 
Dim oshp As Shape 
Dim x As Integer 
folderPath = Environ("USERPROFILE") & "\Desktop\myEMFs\" 
On Error Resume Next 
MkDir folderPath 
Set osld = ActiveWindow.View.Slide 
For Each oshp In osld.Shapes 
    x = x + 1 
    Call oshp.Export(folderPath & "Shape" & CStr(x) & ".emf", ppShapeFormatEMF) 
Next oshp 
End Sub

【讨论】：

【解决方案2】：

这将根据当前演示文稿中所有幻灯片的类型（以防止错误）导出所有形状：

Option Explicit

' ===========================================================================
' PowerPoint Macro
' ===========================================================================
' Purpose : Export all specified shapes in a presentation to vector EMF files
' Inputs : None
' Outputs : None
' Author : Jamie Garroch 09NOV2015
' ===========================================================================
' Copyright (c) 2015 http://youpresent.co.uk/
' Source code is provided under Creative Commons Attribution License
' This means you must give credit for our original creation in the following form:
' "Includes code created by YOUpresent Ltd. (YOUpresent.co.uk)"
' Commons Deed @ http://creativecommons.org/licenses/by/3.0/
' License Legal @ http://creativecommons.org/licenses/by/3.0/legalcode
' ===========================================================================
Sub ExportShapesAsEMF()
  ' Change to the path you want (making sure it ends with \)
  Const sFolderPath = "C:\Temp\test\" 
  Dim objSld As Slide
  Dim objShp As Shape
  Dim strFileName As String
  Dim blnExport As Boolean
  For Each objSld In ActivePresentation.Slides
    For Each objShp In objSld.Shapes
      With objShp
        ' Choose the shape types to export
        Select Case .Type
          ' Basic Shapes
          Case msoAutoShape, msoFreeform, msoLine, msoTextBox
            blnExport = True
          ' Complex Objects
          Case msoChart, msoDiagram, msoGroup, msoSmartArt, msoTable
            blnExport = True
          ' Placeholders
          Case msoPlaceholder
            blnExport = True
          ' Raster Pictures
           Case msoPicture, msoLinkedPicture
          ' Non-Exportable / Undesired shapes
            blnExport = True
          Case msoCallout, msoCanvas, msoComment, msoContentApp, _
            msoEmbeddedOLEObject, msoFormControl, msoInk, msoInkComment, _
            msoLinkedOLEObject, msoMedia, msoOLEControlObject, msoScriptAnchor, _
            msoShapeTypeMixed, msoSlicer, msoTextEffect, msoWebVideo
            blnExport = False
        End Select

        ' Export the shape if it's a type to be exported
        If blnExport Then
          strFileName = "Slide[" & objSld.SlideIndex & "]Shape[" & _
            .ZOrderPosition & "]Name[" & .Name & "].emf"
          .Export sFolderPath & strFileName, ppShapeFormatEMF
        End If
      End With
    Next
  Next

  ' Clean up
  Set objSld = Nothing: Set objShp = Nothing
End Sub

【讨论】：