如何在VBA中将图片（图形对象）复制到剪贴板？

Question

在 Excel 2003 中，我需要将 Graphics 对象 (sheet.PageSetup.LeftFooterPicture) 复制到剪贴板。

我怎样才能做到这一点？

Answer 1

Private Sub Command1_Click()
Clipboard.Clear
Clipboard.SetData Picture1.Picture, vbCFBitmap
Command1.Enabled = False
End Sub

像这样你可以将图片复制到剪贴板。

Answer 2

当我尝试复制似乎不想复制的内容时，我会从键盘打印屏幕，然后将其粘贴到 PAINT 附件。从那里，您可以裁剪掉任何不需要的内容，然后将新图像剪切并粘贴到新的 PAINT 文件中，使其干净。您可以将其保存为 .jpg 以便于使用。

希望有帮助。

Answer 3

正如之前提到的，问题是我无法从图形对象中提取图片（LeftFooterPicture）
看了答案，我确实解决了这个问题。

文件名应包含文件的完整路径，如“C:\myimage.jpg”，但保存工作表后，它将文件名更改为“myiamge”，不包含路径和扩展名。

所以这是我的解决方法：

1. 在“保存”事件之前，我扫描所有工作表并获取其图形，此时“文件名”具有正确的内容（绝对路径，如 C:\mypic.jpg）

2. 我创建一个隐藏工作表并添加所有图片作为 Shape 对象（带有图片路径的 Shapes.AddPicture）

3. 我将当前工作表名称和图片位置与形状绑定name

4. 当我需要将图片复制到剪贴板时，我会在隐藏页面中查找图片（shape.CopyPicture xlScreen，xlPicture）

Answer 4

根据 MSDN 一个 Graphic 通过文件（文件名）加载图像。 文件名 应包含文件的完整路径，如“C:\myimage.jpg”，但保存工作表后，它将文件名更改为“myiamge”，不包含路径和扩展名。我无法在 Excel 中找到对该文件的任何其他引用。

以下代码可能对您有帮助。

Sub yourMethod()
    copyGraphic Me.PageSetup.LeftFooterPicture
End Sub

Sub copyGraphic(srcGraphic As Graphic)
    Dim imagefolder As String
    Dim imageExtension As String
    Dim imagePath As String

    imagefolder = "D:\" '"
    imageExtension = ".gif"

    If InStr(1, srcGraphic.filename, ".") Then
        imagePath = srcGraphic.filename
    Else
        imagePath = imagefolder & srcGraphic.filename & imageExtension
    End If

    Me.Shapes.AddPicture imagePath, False, True, 10, 10, Round(srcGraphic.Width, 0), Round(srcGraphic.Height, 0)
End Sub

您可能希望将 Me. 更改为您的工作表名称和目标工作表。

Answer 5

在 2007 年之前的 Excel 版本中，您无法从页脚中提取图形。您需要拥有原始图像文件。

有关更多详细信息，请参阅上一个问题