截屏后，如何将系统剪贴板上的数据保存为JPG文件

chenlifeng123 · 发表于 2016-7-28 07:57

小fisher 发表于 2013-4-23 09:57
这个程序说起来也不复杂，涉及到两类API函数，一类是剪贴板函数，用于读取剪贴板中的位图句柄，另外一类是G ...

太强大了~！还可以保存为bmp等格式么？

dongdonggege · 发表于 2017-5-12 15:51

小fisher 发表于 2013-4-23 09:57
这个程序说起来也不复杂，涉及到两类API函数，一类是剪贴板函数，用于读取剪贴板中的位图句柄，另外一类是G ...

大师，向您请教下，如果在excel里插入的是包（Packer）对象，文件类型为mp3文件，怎么保存这个包对象？听说你这某个网站写了个windows剪贴板，但是找不到了。请求赐教！感谢大师！
我的音乐文件太大，上传不上去，一时找不到代替的。

YDH318 · 发表于 2018-6-28 15:12

请教一下大神这代码在32位EXCEL中运行是没有问题的,但在64位系统中报错.CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder 说是类型不匹配.如何修改完善代码.

liub168 · 发表于 2019-3-24 12:35

图象处理收藏，谢谢

wangpeng126123 · 发表于 2020-4-18 10:10

小fisher 发表于 2013-4-23 09:57
这个程序说起来也不复杂，涉及到两类API函数，一类是剪贴板函数，用于读取剪贴板中的位图句柄，另外一类是G ...

大神，我用你的代码64位上能正常运行就保存不了图片，我的目的是把图片上传到网站进行文字识别，这个可以不用保存到本地吗，我联系不上你，折腾好久，请你帮忙

qiushuangxia · 发表于 2021-1-7 21:23

YDH318 发表于 2018-6-28 15:12
请教一下大神这代码在32位EXCEL中运行是没有问题的,但在64位系统中报错.CLSIDFromString StrPtr("{557CF40 ...

您好，您的问题后来解决了吗？我也碰到这个问题了

伶俐的毛豆 · 发表于 2021-11-27 10:36

我也遇到同樣的問題，64位win10系統，能運行，跑完程序，但是提示保存失敗

伶俐的毛豆 · 发表于 2022-4-27 12:13

小fisher 发表于 2013-4-23 09:57
这个程序说起来也不复杂，涉及到两类API函数，一类是剪贴板函数，用于读取剪贴板中的位图句柄，另外一类是G ...

這個函數要是能64bit上運行就完美了，我在64bit上總是截圖失敗.

小fisher · 发表于 2022-4-27 20:58

伶俐的毛豆发表于 2022-4-27 12:13
這個函數要是能64bit上運行就完美了，我在64bit上總是截圖失敗.

回复33、35、36、37楼，64位代码如下：

Option Explicit
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
#If VBA7 Then
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, ByVal outputbuf As LongPtr) As LongPtr
Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As LongPtr
Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As LongPtr) As LongPtr
Private Declare PtrSafe Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As LongPtr, ByVal filename As LongPtr, clsidEncoder As GUID, encoderParams As Any) As LongPtr
Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal str As LongPtr, id As GUID) As LongPtr
Private Declare PtrSafe Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As LongPtr, ByVal hPal As LongPtr, BITMAP As LongPtr) As LongPtr
Private Type EncoderParameter
GUID As GUID
NumberOfValues As Long
type As Long
Value As LongPtr
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As LongPtr
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
#Else
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, ByVal outputbuf As Long) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hPal As Long, BITMAP As Long) As Long
Private Type EncoderParameter
GUID As GUID
NumberOfValues As Long
type As Long
Value As Long
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
#End If
Private Const CF_BITMAP = 2
Private Type EncoderParameters
Count As Long
Parameter As EncoderParameter
End Type
Sub test()
Select Case CliptoJPG("c:\test.jpg")
Case 0:
MsgBox "剪贴板图片已保存"
Case 1:
MsgBox "剪贴板图片保存失败"
Case 2:
MsgBox "剪贴板中无图片"
Case 3:
MsgBox "剪贴板无法打开，可能被其他程序所占用"
Case 4:
MsgBox "GDI+错误"
End Select
End Sub
Private Function CliptoJPG(ByVal destfilename As String, Optional ByVal quality As Byte = 80) As Integer
'*****该函数用于取出剪贴板中图片转换为jpg文件另存到指定路径****
'参数说明：
' destfilename:要保存的jpg文件的完整路径，必要参数；
' quality: jpg文件的质量，0-100之间的数值，数值越大，图片质量越高
'返回值：
' 0-保存成功；1-保存失败；2-剪贴板中无位图数据；3-无法打开剪贴板
Dim tSI As GdiplusStartupInput
#If VBA7 Then
Dim lRes As LongPtr
Dim lGDIP As LongPtr
Dim lBitmap As LongPtr
Dim hBmp As LongPtr
#Else
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long
Dim hBmp As Long
#End If
'尝试打开剪贴板
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
'初始化 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
Else
CliptoJPG = 4
End If
End Function

复制代码

opiona · 发表于 2022-11-12 22:47

这个支持一下 64位困扰好久终于找到接解决方案

		自动登录	找回密码
密码			免费注册

[求助] 截屏后，如何将系统剪贴板上的数据保存为JPG文件

评分

最新热点 /1