CODEWITHSUNDEEP
vbaexcel
Sam Rathore
Sam Rathore

Reputation: 13

Picture doesn't get inserted into the Excel file (but only as a reference)

After image inserted in Excel file error

The linked image cannot be displayed. The file may have been moved, renamed, or deleted. Verify that the link points to the correct file and location

is coming when I have share to other and as per mentioned code use in macro. Please I request to you any one help. (I'm using Windows 10 and Excel 10)

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+p
'
Dim pictureNameColumn   As String 'column where picture name is found
Dim picturePasteColumn  As String 'column where picture is to be pasted

Dim pictureName         As String 'picture name
Dim lastPictureRow      As Long   'last row in use where picture names are
Dim pictureRow          As Long   'current picture row to be processed
Dim pathForPicture      As String 'path of pictures

pictureNameColumn = "A"
picturePasteColumn = "E"

pictureRow = 5 'starts from this row

'error handler
On Error GoTo Err_Handler

'find row of the last cell in use in the column where picture names are
lastPictureRow = Cells(Rows.Count, pictureNameColumn).End(xlUp).Row

'stop screen updates while macro is running
Application.ScreenUpdating = False

pathForPicture = "C:\Users\Nimit\Desktop\Dimensional\Insert Image\"
'loop till last row
Do While (pictureRow <= lastPictureRow)

    pictureName = Cells(pictureRow, "A") 'This is the picture name

    'if picture name is not blank then
    If (pictureName <> vbNullString) Then

        'check if pic is present

        'Start If block with .JPG
        If (Dir(pathForPicture & pictureName & ".jpg") <> vbNullString) Then

            Cells(pictureRow, picturePasteColumn).Select 'This is where picture will be inserted
            ActiveSheet.Pictures.Insert(pathForPicture & pictureName & ".jpg").Select 'Path to where pictures are stored

            With Selection
                .Left = Cells(pictureRow, picturePasteColumn).Left
                .Top = Cells(pictureRow, picturePasteColumn).Top
                .ShapeRange.LockAspectRatio = msoFalse
                .ShapeRange.Height = 45#
                .ShapeRange.Width = 55#
                .ShapeRange.Rotation = 0#
            End With
        'End If block with .JPG

        'Start ElseIf block with .PNG
        ElseIf (Dir(pathForPicture & pictureName & ".png") <> vbNullString) Then

            Cells(pictureRow, picturePasteColumn).Select 'This is where picture will be inserted
            ActiveSheet.Pictures.Insert(pathForPicture & pictureName & ".png").Select 'Path to where pictures are stored

            With Selection
                .Left = Cells(pictureRow, picturePasteColumn).Left
                .Top = Cells(pictureRow, picturePasteColumn).Top
                .ShapeRange.LockAspectRatio = msoFalse
                .ShapeRange.Height = 45#
                .ShapeRange.Width = 50#
                .ShapeRange.Rotation = 0#
            End With
        'End ElseIf block with .PNG

        'Start ElseIf block with .BMP
        ElseIf (Dir(pathForPicture & pictureName & ".bmp") <> vbNullString) Then

            Cells(pictureRow, picturePasteColumn).Select 'This is where picture will be inserted
            ActiveSheet.Pictures.Insert(pathForPicture & pictureName & ".bmp").Select 'Path to where pictures are stored

            With Selection
                .Left = Cells(pictureRow, picturePasteColumn).Left
                .Top = Cells(pictureRow, picturePasteColumn).Top
                .ShapeRange.LockAspectRatio = msoFalse
                .ShapeRange.Height = 45#
                .ShapeRange.Width = 50#
                .ShapeRange.Rotation = 0#
            End With
        'End ElseIf block with .BMP

        Else
            'picture name was there, but no such picture
            Cells(pictureRow, picturePasteColumn) = "No Picture Found"
        End If

    Else
    'picture name cell was blank
    End If
    'increment row count
    pictureRow = pictureRow + 1
Loop

Exit_Sub:
Range("A10").Select
Application.ScreenUpdating = True
Exit Sub

Err_Handler:
MsgBox "Error encountered. " & Err.Description, vbCritical, "Error"
GoTo Exit_Sub

End Sub

Upvotes: 1

Views: 3083

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

ActiveSheet.Pictures.Insert always inserts a picture as a reference to a file. If the picture file is missing on other computers (when you share the Excel file) it can't be displayed.

To insert a picture permanently into an Excel file try the following:

ActiveSheet.Shapes.AddPicture Filename:="C:\Temp\barcode.png", LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, Left:=Selection.Left, Top:=Selection.Top, Width:=-1, Height:=-1

See here for the reference to the Shapes.AddPicture method.

Upvotes: 2

Related Questions