在Excel 2007中将工作表复制到另一个工作簿时，插入的图像无法显示

Question

在工作簿A中，我有一个宏打开只读工作簿B，将4个工作表复制到工作簿A，然后关闭工作簿B。

其中一个复制的工作表包含两个插入的。png图像，但是一旦复制到工作簿a，这些图像就无法在工作表上显示。

在我将网络文件夹B工作簿添加到信任中心设置中，并在高级选项下勾选"剪切，复制，使用父单元格排序"选项后，我可以看到带有错误信息的图像轮廓

"图像无法显示.. "可能没有足够的内存…或图像损坏…"

在复制的工作表上。

我怀疑任何一个错误是正确的，因为如果我手动复制工作表，图像显示成功。

我记录了一个宏这样做，并将代码插入到宏中，但当我运行它时只是得到上面的错误，这表明VBA是罪魁祸首。

我还解压缩了工作簿A xlsx文件，以确认两个图像都存储在xlsx文件中，而不是从其他地方导入。

我考虑编写代码来明确地复制和粘贴图像，但在VBA中看不到任何方式，我可以在目标工作表上编码我想要粘贴的图像的确切位置。

我在XP上运行Excel 2007。

任何想法?

Answer 1

我一直无法解决复制图像不显示的问题(并且自从发布我发现它们是否正确显示或生成错误消息似乎随机发生)，但是我已经找出了一个可行的解决方案，即删除复制的工作表上的图像容器，然后从文件中插入徽标，并将它们定位在工作表上。

我修改了VBA代码，我发现:http://www.exceltip.com/st/Insert_pictures_using_VBA_in_Microsoft_Excel/486.html如下:

Function InsertImageInRange(Image1_Filepath As String, Image2_Filepath As String, TargetSheet As String, TargetCell1 As Range, TargetCell2 As Range)
    ' Insert a picture(s) and resize to fit the TargetCells range
    ' This workaround deletes the image containers and copies in the original logos from file.
    Dim dblTop As Double, dblLeft As Double, dblWidth As Double, dblHeight As Double   
    Dim objImage As Object         
    Sheets(TargetSheet).Select  
    ' Check that images are valid
    bUnexpectedImage = True
    For Each img In ActiveSheet.Shapes
        If img.Name = "Picture 1" Or img.Name = "Picture 22" Then
            img.Delete
        Else
            bUnexpectedImage = False
        End If
    Next
    If bUnexpectedImage = False Then MsgBox ("Unexpected images found.")
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Function
    If Dir(Image1) = "" Then Exit Function
    ' Insert first logo
    Set objImage = ActiveSheet.Pictures.Insert(Image1)
    ' Determine positions
    With TargetCell1
        dblTop = .Top
        dblLeft = .Left
        dblWidth = .Offset(0, .Columns.Count).Left - .Left
        dblHeight = .Offset(.Rows.Count, 0).Top - .Top
    End With
    ' Position  & size image
    With objImage
        .Top = dblTop
        .Left = dblLeft + 13
        .Width = dblWidth + 25
        .Height = dblHeight + 15
    End With
    Set objImage = Nothing
    ' Insert second logo, as above...    
End Function