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")

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

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

Answer 2

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

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

Answer 3

晚上好... 此代码段将复制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

结束子

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

3 个答案: