Question

我有以下情况：

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

你知道我怎么解决这个问题吗？

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

谢谢，最好的，拉尔夫

Answer 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

Answer 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

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

2 个答案: