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

时间:2011-12-30 23:06:34

标签: excel vba

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

3 个答案:

答案 0 :(得分:5)

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

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

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

  • for Office 2003粘贴的图像没有完全绑定到左上角 范围的一角;如果你定义一个单独的单元格图像可能会得到 位置越往左,越低,甚至可能得到相邻的单元;所以 您必须使用“顶”和“左”属性执行重新对齐过程 (见下文);
  • 用于Office 2003粘贴图片IS NOR选择,所以特殊程序 必须完成以识别Shapes集合中的图像;

  • 选择Office 2007图像并绑定到左上角 指定的范围,因此可以使用Selection属性来更改 集合中的图像属性(例如名称);

  • 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

答案 1 :(得分:2)

图片未插入单元格。图片被插入到工作表上,然后可以对齐,以便左上角在视觉上匹配某个单元格的左上角。

要从剪贴板插入图片,请使用Sheet1.Paste()

答案 2 :(得分:0)

晚上好... 此代码段将复制Windows PC剪贴板中的任何图像,并将其粘贴到工作表选项卡“ Sheet1”,然后将其复制到新图表。然后,该图表将作为jpg文件导出到代码中指定名称的网络文件夹中。

子Count_Shapes_click()     '注意:Count_Shapes是一个命令按钮

' NOTE: MyChart is the new chart where the image will eventually be copied to
'       in order to then be exported as a jpg file
Dim MyChart As Chart


' NOTE: The workbook sheet "Sheet1" will be made the active sheet
Sheet1.Activate

' NOTE: This will past whatever is currently in the clipboard to the active sheet
'       So, make sure that your image is what was most recently copied
'
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A1:zz10")

' NOTE: This is creating the new Chart
    Set MyChart = Charts.Add

' NOTE: This is name the new chart
MyChart.Name = "HELLO"

' NOTE: This is moving the chart to the sheet where the picture is
Set MyChart = MyChart.Location(Where:=xlLocationAsObject, Name:="Sheet1")

' NOTE: This is making the width and height of the MyChart equal to whatever image you copied to the clipboard
MyChart.ChartArea.Width = Sheet1.Shapes(2).Width
MyChart.ChartArea.Height = Sheet1.Shapes(2).Height

' NOTE: This is removing the shape container boarder
MyChart.Parent.Border.LineStyle = 0

' NOTE: This is copying the image that was pasted to the sheet "Sheet1"
Sheet1.Shapes(2).Copy

' NOTE: This is selecting or making active the ChartArea of MyChart
MyChart.ChartArea.Select

' NOTE: This is pasting the image that was just copied via VBA of EXCEL into the MyChart ChartArea
MyChart.Paste

' NOTE: This is exporting the MyChart to a jpg file.
'       Filename:="location of folder\name of the file.XXX"
'       FilterName:="jpg" read about this at - > https://docs.microsoft.com/en-us/office/vba/api/Excel.Chart.Export
MyChart.Export Filename:="J:\TEMP\LIBERTY\Images\HI Me.jpg", FilterName:="jpg"

' NOTE: Make cell (Row 1, Column A) the active cell
Sheet1.Cells(1, 1).Activate

' NOTE: Delete the Chart you created earlier
Sheet1.ChartObjects(Sheet1.ChartObjects.Count).Delete

' NOTE: Delete the (hopefully) only 1 shape (image pasted ealier) on the sheet "Sheet1"
Sheet1.Shapes(1).Delete

结束子