Excel VBA及Access VBA自动获取剪切板图片保存为文件

应版主的邀请，把早期2016年为一个客户写的一个VBA获取剪贴板中的图片，另存为文件或加载到图片控件中的代码分享一下

一、客户的需求：一键把剪切板图片加载到图片控件

客户的需求是把微信 QQ 中的复制的图片粘贴在Access系统中，之前一直是先将微信中的图片另存为一个文件，再在Access中选择这个图片，要多个步骤才能实现，客户提出能否直接复制粘贴就能实现。

二、实现的效果：按Ctr+V直接贴图

用户在图片框按Ctr+V 即可直接将 剪切板中的图片加载到图片控件，一键实现，非常高效

三、获取剪切板的图片并加载到图片控件的思路

1、打开剪切板

2、判断里面有否图片

3、使用gdi 将图片另存为文件

4、Access图片控件加载图片控件 （也可考虑直接从图片流，不经过文件的方法）

四、获取剪切板的图片转为图片文件的核心代码

Option Compare DatabaseOption Explicit Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function CloseClipboard Lib "user32" () As LongPrivate Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPrivate Const CF_BITMAP = 2Private Type GUIDData1 As LongData2 As IntegerData3 As IntegerData4(0 To 7) As ByteEnd TypePrivate Type GDIPlusStartupInputGdiPlusVersion As LongDebugEventCallback As LongSuppressBackgroundThread As LongSuppressExternalCodecs As LongEnd TypePrivate Type EncoderParameterGUID As GUIDNumberOfValues As LongType As LongValue As LongEnd TypePrivate Type EncoderParametersCount As LongParameter As EncoderParameterEnd TypePrivate Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GDIPlusStartupInput, ByVal outputbuf As Long) As LongPrivate Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As LongPrivate Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As LongPrivate Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal image As Long, ByVal Filename As Long, clsidEncoder As GUID, encoderParams As Any) As LongPrivate Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As LongPrivate Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, bitmap As Long) As LongSub TEST()    Select Case CliptoJPG("c:\test.jpg")        Case 0:            MsgBox "剪贴板图片已保存"        Case 1:            MsgBox "剪贴板图片保存失败"        Case 2:            MsgBox "剪贴板中无图片"        Case 3:            MsgBox "剪贴板无法打开，可能被其他程序所占用"    End SelectEnd SubPublic Function CliptoJPG(ByVal destfilename As String, Optional ByVal Quality As Byte = 80, Optional blnJustCheck As Boolean = False) As Integer'*****该函数用于取出剪贴板中图片转换为jpg文件另存到指定路径****  修改:2016/07/18'参数说明：'     destfilename:要保存的jpg文件的完整路径，必要参数；'     quality: jpg文件的质量，0-100之间的数值，数值越大，图片质量越高'返回值：'     0-保存成功；1-保存失败；2-剪贴板中无位图数据；3-无法打开剪贴板    Dim tSI As GDIPlusStartupInput    Dim lRes As Long    Dim lGDIP As Long    Dim lBitmap As Long    Dim hBmp As Long       '尝试打开剪贴板    If OpenClipboard(0) Then        '尝试取出剪贴板中位图的句柄        hBmp = GetClipboardData(CF_BITMAP)        '如果hBmp为0，说明剪贴板中没有存放图片        If hBmp = 0 Then            CliptoJPG = 2            CloseClipboard            Exit Function        End If        CloseClipboard    Else   '如果openclipboard返回0(False)，说明剪贴板被其他程序所占用        CliptoJPG = 3        Exit Function    End If        If blnJustCheck Then Exit Function       '初始化 GDI+    tSI.GdiPlusVersion = 1    lRes = GdiplusStartup(lGDIP, tSI, 0)         If lRes = 0 Then        '从句柄创建 GDI+ 图像        lRes = GdipCreateBitmapFromHBITMAP(hBmp, 0, lBitmap)                 If lRes = 0 Then            Dim tJpgEncoder As GUID            Dim tParams As EncoderParameters                        '初始化解码器的GUID标识            CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder                        '设置解码器参数            tParams.Count = 1            With tParams.Parameter ' Quality                '得到Quality参数的GUID标识                CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID                .NumberOfValues = 1                .Type = 4                .Value = VarPtr(Quality)            End With                        '保存图像            lRes = GdipSaveImageToFile(lBitmap, StrPtr(destfilename), tJpgEncoder, tParams)            If lRes = 0 Then                CliptoJPG = 0  '转换成功            Else                CliptoJPG = 1  '转换失败            End If                        '销毁GDI+图像            GdipDisposeImage lBitmap        End If                 '销毁 GDI+        GdiplusShutdown lGDIP    End IfEnd Function五、监控按键的事件

至于按钮的处理就简单了，大致使用下面的方式实现的

大致就是这样实现的.