将剪贴板中的图像粘贴到Excel中的单元格中
我想使用vba将剪贴板中的图像粘贴到Excel单元格中。 我能找到这样的代码:将剪贴板中的图像粘贴到Excel中的单元格中
If My.Computer.Clipboard.ContainsImage() Then
Dim grabpicture = My.Computer.Clipboard.GetImage()
PictureBox1.Image = grabpicture
End If
但这里grabpicture变量是一个对象。如何从图像对象更新单元格。 这样,
Sheet1.Range("D11").Value = grabpicture
图片没有插入到单元格中。图片被插入到表格中,然后可以对齐,以便左上角可视地匹配某个单元格的左上角。
要从剪贴板插入图片,请使用Sheet1.Paste()
。
要通过剪贴板标准方法将图像从一张图片移动到另一张图片,请使用复制粘贴。对于粘贴方法,必须定义该图像要被粘贴的范围内,例如(可以跳过目的地参数):
Worksheets("Sheet1").Range("C1:C5").Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("D1:D5")
的图象被插入在指定的区域中,但某些特性存在:
- 对于Office 2003粘贴图像没有完全绑定到左上角的 范围的角落;如果你定义一个单独的单元格,图像可能会得到更多的左边和下边的位置,甚至可能得到相邻的单元格;所以 你必须使用Top和Left属性 (见下文)执行重新对齐过程;
对于Office 2003粘贴图片IS NOR选择,因此必须执行特殊程序 才能识别Shapes集合中的图像; Office 2007的图像被选择,并绑定到的 指定范围左上角,所以选择属性可以被用来将图像 属性更改在集合中(名称例如)
;
在Shapes集合中粘贴的图像索引变成最上面但是在 图片集(Type = msoPicture);在Office 2003 Shapes中分组为 ,因此首先是控件块(Lstbox,Combobox, 等),图像块是后者,因此粘贴图像索引实际上是 中的最后一个集合;对于Office 2007图像块,结果为 应位于控件块之前,因此您应该搜索IMAGE BLOCK (请参见下面的示例)元素之间最后粘贴图像的 索引;
要取消选择粘贴的图像(不是偶然删除它),您应该将焦点移动到任何单元格/例如Range(“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