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

时间:2011-04-11 05:30:45

标签: excel excel-2007

在工作簿A中我有一个打开只读工作簿B的宏,将4张打印到工作簿A中,然后关闭工作簿B.

其中一张复印的纸张包含两张插入的.PNG图像,但这些图像在复印到工作簿A后无法显示在纸张上。

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

  

“图像显示..可能没有足够的内存..或图像已损坏..”

复印的纸张上的

我怀疑这两个错误是否正确,因为如果我手动复制工作表,图像会成功显示。

我录制了一个宏来执行此操作并将代码插入到宏中,但在运行时只是出现上述错误,这表明VBA是罪魁祸首。

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

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

我在XP上运行Excel 2007。

有什么想法吗?

1 个答案:

答案 0 :(得分:0)

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

我修改了我在http://www.exceltip.com/st/Insert_pictures_using_VBA_in_Microsoft_Excel/486.html找到的VBA代码 如下:

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