可否用VBA实现Base64 图片复制到粘贴板

aman1516 · 发表于 2024-4-9 23:51

网上一段代码，将Base64图片复制到粘贴板：

function b64toBlob(b64Data, contentType = null, sliceSize = null) {
contentType = contentType || 'image/png'
sliceSize = sliceSize || 512
let byteCharacters = atob(b64Data)
let byteArrays = []
for (let offset = 0; offset < byteCharacters.length; offset += sliceSize) {
let slice = byteCharacters.slice(offset, offset + sliceSize)
let byteNumbers = new Array(slice.length);
for (let i = 0; i < slice.length; i++) {
byteNumbers[i] = slice.charCodeAt(i)
}
var byteArray = new Uint8Array(byteNumbers)
byteArrays.push(byteArray)
}
return new Blob(byteArrays, {type: contentType})
}

复制代码

function clip(b64Data) {
const item = new clipboard.ClipboardItem({
"image/png": this.b64toBlob(b64Data.replace('data:image/jpg;base64,', ''), 'image/png', 512)
});
}

复制代码

请教下，可否用VBA实现，执行粘贴即为图片

蓝桥玄霜 · 发表于 2024-4-10 08:43

ChatGPT的回答：

要实现这个功能，我们需要使用VBA与Windows API来实现将Base64编码的图片转换为用户可以通过粘贴操作插入到目标应用中的图片。以下是实现此功能的步骤：
转换Base64为图像并保存
首先，我们需要将Base64编码的字符串转换为图像，并且保存为一个临时文件。对于这个操作，我们可以使用ADODB.Stream和GDI+ API。
使用Windows API实现复制粘贴
然后，我们将使用Windows API来进行复制到剪贴板的操作。涉及到的API函数包括OpenClipboard, EmptyClipboard, SetClipboardData, 和 CloseClipboard。
实现步骤
转换Base64字符串为图片文件
使用VBA的ADODB.Stream对象解码Base64字符串并保存为图片文件（例如，临时的JPEG文件）。
复制图片到剪贴板
使用Windows API操作，将图片文件复制到剪贴板上。
这是一个大概的例子来说明这些步骤：
vb
Option Explicit
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 SetClipboardData Lib "user32" (ByVal uFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInstance As LongPtr, ByVal lpFileName As String, ByVal uType As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal fuLoad As Long) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Const CF_BITMAP = 2
Private Const IMAGE_BITMAP = 0
Private Const LR_LOADFROMFILE = &H10
Private Const GMEM_MOVEABLE = &H2
Sub Base64ToClipboard(Base64String As String)
Dim bytes() As Byte
Dim ImagePath As String
Dim hBitmap As LongPtr
' 将Base64字符串转换为字节数组
bytes = DecodeBase64(Base64String)
' 将字节数组写入临时文件
ImagePath = SaveBytesToTempImageFile(bytes)
' 使用API加载该图片为位图
hBitmap = LoadImage(0, ImagePath, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
If hBitmap <> 0 Then
If OpenClipboard(0&) Then
Call EmptyClipboard()
' 复制到剪贴板
Call SetClipboardData(CF_BITMAP, hBitmap)
Call CloseClipboard()
End If
End If
' 清理：删除临时文件
Kill ImagePath
End Sub

复制代码

aman1516 · 发表于 2024-4-10 12:44

蓝桥玄霜发表于 2024-4-10 08:43
ChatGPT的回答：

感谢版主关注，先把Base64字符串生成图片文件，再将图片导入、复制到粘贴板是可以的，
只是感觉明显走一弯路，网上看到多种语言，都能实现一步到位：
在内存中就将Base64字符串转为粘贴板中的图片格式，按Ctrl+V 就直接粘贴为图片了，
只想用VBA能否实现这一功能

perfect131 · 发表于 2024-4-10 17:24

aman1516 发表于 2024-4-10 12:44
感谢版主关注，先把Base64字符串生成图片文件，再将图片导入、复制到粘贴板是可以的，
只是感觉明显走一 ...

就是 5楼跟 8楼的结合
https://club.excelhome.net/thread-1602346-1-1.html

joforn · 发表于 2024-4-10 22:07

很简单：第一步，将BASE64字符串转换成Byte数组；第二步：将Byte数组转换成Stream；第三步：使用gdi+函数从Stream加载图片；第四步：使用Gdi+将加载到的图片Image转化成BitMAP格式；第五步：将BitMPA写入写字板；后面再加上一些释放函数，从后往前将BitMAP、Imag、Stream、Byte数组依次释放以防内存泄露

aman1516 · 发表于 2024-4-10 23:36

perfect131 发表于 2024-4-10 17:24
就是 5楼跟 8楼的结合
https://club.excelhome.net/thread-1602346-1-1.html

原来贴子数组形式不一样，基础不牢，地动山摇，“依葫芦画瓢”弄了两天，怎么也转不过来才开新贴求助，
还老师利害，实在无言言感激！
再次做个代码搬运工，终于弄好了：

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

[求助] 可否用VBA实现Base64 图片复制到粘贴板