VBA实用小程序5１： 将图表导出为图片（API版）

学习Excel技术，关注微信公众号：

excelperfect

在前面的VBA实用小程序15和16中，我们给出了两个将Excel图表导出为图片的VBA程序，详见下面的链接：

VBA实用小程序15：将Excel图表导出为图片

VBA实用小程序16：将Excel图表导出为图片（增强版）

这里给出的小程序来自dailydoseofexcel.com，使用Windows API来将Excel图表导出为图片。代码如下：

代码语言：javascript复制

Declare Function OpenClipboard _
    Lib "user32" _
    (ByVal hwnd As Long) As Long
Declare Function CloseClipboard _
    Lib "user32" () As Long
Declare Function GetClipboardData _
    Lib "user32" _
    (ByVal wFormat As Long) As Long
Declare Function EmptyClipboard _
    Lib "user32" () As Long
Declare Function CopyEnhMetaFileA _
    Lib "gdi32" _
    (ByVal hENHSrc As Long, _
    ByVal lpszFile As String) As Long
Declare Function DeleteEnhMetaFile _
    Lib "gdi32" _
    (ByVal hemf As Long) As Long
Const CF_ENHMETAFILE As Long = 14
Const cInitialFilename= "Picture1.emf"
Const cFileFilter ="扩展的Windows图元文件(*.emf), *.emf"
Public Sub SaveAsEMF()
    Dim var As Variant, lng As Long
    var = Application.GetSaveAsFilename _
        (cInitialFilename, cFileFilter)
    If VarType(var) <> vbBoolean Then
        On Error Resume Next
        Selection.Copy
        OpenClipboard 0
        lng = GetClipboardData(CF_ENHMETAFILE)
        lng = CopyEnhMetaFileA(lng, var)
        EmptyClipboard
        CloseClipboard
        DeleteEnhMetaFile lng
        On Error GoTo 0
    End If
End Sub

注意，在运行SaveAsEMF过程之前，需要先选中Excel图表。

程序代码的图片版如下：

欢迎分享本文，转载请注明出处。

vba 小程序 微信

0 人点赞