excel - 将剪贴板中的图像粘贴到 Excel 中的单元格

Question

我想使用 vba 将剪贴板中的图像粘贴到 excel 单元格中。
我可以找到这样的代码:

If My.Computer.Clipboard.ContainsImage() Then
Dim grabpicture = My.Computer.Clipboard.GetImage()
PictureBox1.Image = grabpicture
End If

但这里的grabpicture 变量是一个对象。如何从图像对象更新单元格。
像这样，

Sheet1.Range("D11").Value = grabpicture

Answer 1

要通过剪贴板标准方法将图像从一张纸移动到另一张纸，请使用复制粘贴。对于 Paste 方法，您必须定义要粘贴图像的范围，例如(您可以跳过 Destination 参数):

Worksheets("Sheet1").Range("C1:C5").Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("D1:D5")

在指定区域插入图片，但存在一些特殊性:

对于 Office 2003 粘贴的图像未完全绑定(bind)到左上角
范围的角落；如果你定义一个单独的单元格，图像可能会得到
位置越左越低，甚至可能得到相邻单元格；所以
您必须使用 Top 和 Left 属性执行重新对齐过程
(见下文);

对于 Office 2003 粘贴图片 IS NOR 选择，所以特殊程序
必须完成以识别 Shapes 集合中的图像；

对于 Office 2007 图像被选中并绑定(bind)到左上角
指定范围，因此可以使用 Selection 属性来更改
集合中的图像属性(例如名称)；

在 Shapes 集合中粘贴的图像索引成为最重要的 BUT AMONG
图片集(类型=msoPicture)；在 Office 2003 中，形状是
分组以便首先是控件 block (Lstbox、Combobox、
等)和图像 block 是后者，所以粘贴的图像索引实际上是
在所有集合中的最后一个；对于 Office 2007 图像 block 原来是
在控制 block 之前，因此您应该搜索
IMAGE BLOCK 元素之间最后粘贴的图像的索引
(见下面的例子)；

要取消选择粘贴的图像(不要意外删除)，您应该
将焦点移动到任何单元格/例如 Range("A1").Select。

因此，要编写一个可以在 Office 2003 或 Office 2007 环境中正常工作的通用程序，您应该:

首先，使用特殊程序找出粘贴的图像(它在 Shapes 集合中的引用或索引)；

其次，将图像对齐到图像粘贴范围的左上角；

第三，将焦点移至另一个单元格。

下面是定义 Shapes 集合中最后粘贴图像的索引的函数:

Function GetIndexPastedPicture() As Integer
' Pasted picture has the upmost index among the PICTURE block 
' But it is not necessarily the last inde[ in whole collection
' set reference to target sheet with pasted image
Set ThisDBSheet = Workbooks("BookName.xls").Worksheets("SheetName")
Dim sh As Shape, picIdx As Integer
picIdx = 0 ' initial value of index in Shapes collection, starts from 1
For Each sh In ThisDBSheet.Shapes
    If sh.Type = msoPicture Then ' image found
        picIdx = sh.ZOrderPosition ' image index
    End If
Next
' after For loop, picIdx - is the last index in PICTURE block 
GetIndexPastedPicture = picIdx
End Function

然后(假设剪贴板已经有正确的图像)粘贴图像的过程如下所示:

Sub InsPicFromClipbrd(sInsCell As String, sPicName As String)
' Image is pasted to cell with name sInsCell,
' it is aligned to upper-left corner of the cell, 
' pasted image gets name sPicName in Shapes collection
' set reference to target sheet with pasted image
Set ThisDBSheet = Workbooks("BookName.xls").Worksheets("SheetName")
ThisDBSheet.Paste Destination:=Range(sInsCell) ' paste image fom clipboard
c1 = GetIndexPastedPicture() ' get index of pasted image (see above)
With ThisDBSheet.Shapes.Item(c1) ' correct the properties of the pasted image 
    .Top = Range(sInsCell).Top ' top alignment
    .Left = Range(sInsCell).Left ' left alignment
    .Name = sPicName ' assign new name
End With
Range("I18").Activate ' move focus from image
End Sub 'InsPicFromClipbrd