Assign location to picture after import with VBA

[Olanda]

first compliments for the board, I get a lot of information from here. Thanks.

I've made a nice macro which imports images from a designated filemap on C:/ into the sheet. The name of the imported files is in Colomn A, and the image must be imported into Colomn B.

The import works fine, all the images are imported into the sheet, but are all stacked together on 1 place (around cell C3). I want them to be imported into colomn B, in the same row as the file name in Colomn A.

This is the macro code i'm using. I hope somebody can help me.

Sub Macro1()
    Range("a2").Select
    On Error Resume Next
    
    Do Until ActiveCell.Value = ""
    Afb_naam = "Images\75dpi\" & ActiveCell.Value
    Afb_map = "c:\"
    Afb_bestandsnaam = Afb_map & Afb_naam & ".jpg"
    
    ActiveCell.Offset(0, 1).Select
    
    If Dir(Afb_bestandsnaam) <> "" Then
    ActiveSheet.Pictures.Insert(Afb_bestandsnaam).Name = Afb_naam
    Rows(ActiveCell.Row & ":" & ActiveCell.Row).RowHeight = ActiveSheet.Shapes(Afb_naam).Height
    Else: ActiveCell.Value = "Foto bestaat niet"
    End If
    ActiveCell.Offset(1, -1).Select
    Loop
End Sub

 

[VoG]

Perhaps like this

Sub Macro1()
    Range("a2").Select
    On Error Resume Next
    
    Do Until ActiveCell.Value = ""
    Afb_naam = "Images\75dpi\" & ActiveCell.Value
    Afb_map = "c:\"
    Afb_bestandsnaam = Afb_map & Afb_naam & ".jpg"
    
    ActiveCell.Offset(0, 1).Select
    
    If Dir(Afb_bestandsnaam) <> "" Then
    ActiveSheet.Pictures.Insert(Afb_bestandsnaam).Name = Afb_naam
    Rows(ActiveCell.Row & ":" & ActiveCell.Row).RowHeight = ActiveSheet.Shapes(Afb_naam).Height
    With ActiveSheet.Shapes(Afb_naam)
        .Top = ActiveCell.Top
        .Left = ActiveCell.Left
    End With
    Else: ActiveCell.Value = "Foto bestaat niet"
    End If
    ActiveCell.Offset(1, -1).Select
    Loop
End Sub

 

[Olanda]

Hey VoG,

that was fast, that's the perfect solution for me!

I'm almost ashamed that I couldn't figure this out for myself. Thanks a lot!

 

[Anigito]

Thank you for a very useful topic!

A slight alteration is required to change the height of the image. Should it go to the

"With ActiveSheet.Shapes(Afb_naam)
.Top = ActiveCell.Top ... "

part?

Does the ".Height" property exist, please?

 

[VoG]

Yes a picture has Height and Width properties, so you can use code like

    With ActiveSheet.Shapes(Afb_naam)
        .LockAspectRatio = False
        .Top = ActiveCell.Top
        .Left = ActiveCell.Left
        .Height = ActiveCell.RowHeight
        .Width = ActiveCell.Width
    End With

 

[Anigito]

Thank you for the explanation. Please correct me, if I am wrong, the code for me (with image height 50px) should look like:

    With ActiveSheet.Shapes(Afb_naam)
    [COLOR="Red"]    .LockAspectRatio = True[/COLOR]
        .Top = ActiveCell.Top
        .Left = ActiveCell.Left
       [COLOR="red"] .Height = 50[/COLOR]
    End With

 

[VoG]

Yes, that is correct.