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

我想使用 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

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

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

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

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

• 对于 Office 2003，未选择粘贴图片，因此需要特殊程序 必须识别 Shapes 集合中的图像；

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

• Shapes 集合中粘贴的图像索引成为最重要的但其中 图片集（类型=msoPicture）；在 Office 2003 中，形状是 分组，以便第一个是控件块（Lstbox、Combobox、 等）而图像块是后者，所以粘贴的图像索引实际上是 所有集合中的最后一个；对于 Office 2007 图像块结果是 在控件块之前，因此您应该搜索 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