Inserted image fails to display when sheet is copi

2019-08-18 06:11发布

In workbook A I have a macro that opens read-only workbook B, copies 4 sheets into workbook A, then closes workbook B.

One of the copied sheets contains two inserted .PNG images but these images fail to display on the sheet once it's copied over to workbook A.

After I added the network folder workbook B resides in to the Trust Center settings and ticked the 'Cut, copy, sort with parent cells' option under Advanced options, I could see the image outlines with the error message

"The image canot be displayed.. may not have enough memory..or image is corrupted.."

on the copied sheet.

I doubt either error is correct because if I manually copy the sheet over, the images display successfully.

I recorded a macro doing this and inserted the code into the macro but just get the above error when I run it, which suggests VBA is the culprit.

I also unzipped the workbook A xlsx file to confirm both images are stored in the xlsx file and not imported from elsewhere.

I considered writing code to explicitly copy and paste the images but can't see any way in VBA that I can code the exact locations on the target sheet I want the images pasted.

I am running Excel 2007 on XP.

Any ideas?

1条回答
Juvenile、少年°
2楼-- · 2019-08-18 06:39

I have been unable to resolve the problem of copied images not displaying (and since posting I have found that whether they display correctly or generate an error message seems to occur randomly), however I have figured out a viable workaround that deletes the image containers on the copied sheet then inserts the logos from file, and positions them on the sheet.

I modified VBA code I found at: http://www.exceltip.com/st/Insert_pictures_using_VBA_in_Microsoft_Excel/486.html as follows:

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
查看更多
登录 后发表回答