将图像从剪贴板粘贴到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

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

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

在指定区域中插入图片,但存在一些特殊情况:

• 对于Office 2003粘贴的图像没有完全绑定到范围的左上角; 如果你定义一个单独的单元格,图像可能会得到更多的左下位置,甚至可能得到相邻的单元格; 所以你必须使用Top和Left属性执行重新调整过程(见下文);

• 对于Office 2003粘贴图片IS NOR已选中,因此必须执行特殊程序以识别Shapes集合中的图像;

• for Office 2007图像被选中并绑定到指定范围的左上角,因此Selection属性可用于更改集合中的图像属性(例如Name);

• Shapes集合中的粘贴图像索引成为最重要但是设置的图片(Type = msoPicture); 在Office 2003中对形状进行分组,使得第一个是控件块(Lstbox,Combobox等),而图像块是后者,所以粘贴的图像索引实际上是所有集合中的最后一个; 对于Office 2007图像块原来是在控件块之前,因此您应该在IMAGE BLOCK元素之间搜索最后粘贴图像的索引(参见下面的示例);

• 要取消选择粘贴的图像(不要意外删除),您应该将焦点移动到任何单元格/例如作为范围("A1").选择.

因此,要编写在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