VBA for inserting photos

[trevolly]

Hi all,

I've made a form to act as a billing invoice for when my team carry out a response process at Gatwick Airport. Its a simple drop down system but I'd like the user of the form to be able to add photos as evidence of the issue that we attended (the companies we will bill will argue that the issue wasn't there / or their responsibility). The form will be filled in and then will be saved as a worksheet and exported as a PDF.

I've found some vba coding on these forums that works well - opening a selection folder and when the picture is added it all attaches fine to the specified area on the sheet. I'd like to be able to add multiple photos (up to three in total) but the vba I've found only puts the picture in to the pre defined area "C8" and on another press just puts another photo over the top of the first. Is there any way that the vba can be coded so that on a second and third press / photo entry it would move on to another area of the worksheet? Ie: 1st photo in C8, 2nd photo in C20, 3rd photo in C32?

As always your help is greatly appreciated.
Trevor

The vba I'm using is .....

Sub GetPic()
    Dim fNameAndPath As Variant
    Dim img As Shape
    
    fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
    If fNameAndPath = False Then Exit Sub
    Set img = ActiveSheet.Shapes.AddPicture(Filename:=fNameAndPath, _
                                            LinkToFile:=False, SaveWithDocument:=True, _
                                            Left:=1, Top:=1, Width:=-1, Height:=-1)
    With img
        'Resize Picture to fit in the range....
        .Left = ActiveSheet.Range("C8").Left
        .Top = ActiveSheet.Range("C8").Top
        .Width = ActiveSheet.Range("C8:G8").Width
        .Height = ActiveSheet.Range("C8:C18").Height
        .Placement = 1
        .DrawingObject.PrintObject = True
    End With
End Sub

 

[Georgiboy]

Maybe the below will help:

Sub GetPic()
    Dim fNameAndPath As Variant
    Dim img As Shape
    Dim shp As Shape
    Dim rng As Range
    
    For Each shp In ActiveSheet.Shapes
        Set rng = shp.BottomRightCell.Offset(1, -4)
    Next shp
    If rng Is Nothing Then Set rng = Range("C8")
    
    fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
    If fNameAndPath = False Then Exit Sub
    Set img = ActiveSheet.Shapes.AddPicture(Filename:=fNameAndPath, _
                                            LinkToFile:=False, SaveWithDocument:=True, _
                                            Left:=1, Top:=1, Width:=-1, Height:=-1)

    With img
        'Resize Picture to fit in the range....
        .Left = rng.Left
        .Top = rng.Top
        .Width = rng.Resize(, 5).Width
        .Height = rng.Resize(11).Height
        .Placement = 1
        .DrawingObject.PrintObject = True
    End With
End Sub

 

[trevolly]

Maybe the below will help:

Sub GetPic()
    Dim fNameAndPath As Variant
    Dim img As Shape
    Dim shp As Shape
    Dim rng As Range
   
    For Each shp In ActiveSheet.Shapes
        Set rng = shp.BottomRightCell.Offset(1, -4)
    Next shp
    If rng Is Nothing Then Set rng = Range("C8")
   
    fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
    If fNameAndPath = False Then Exit Sub
    Set img = ActiveSheet.Shapes.AddPicture(Filename:=fNameAndPath, _
                                            LinkToFile:=False, SaveWithDocument:=True, _
                                            Left:=1, Top:=1, Width:=-1, Height:=-1)

    With img
        'Resize Picture to fit in the range....
        .Left = rng.Left
        .Top = rng.Top
        .Width = rng.Resize(, 5).Width
        .Height = rng.Resize(11).Height
        .Placement = 1
        .DrawingObject.PrintObject = True
    End With
End Sub

Thanks @Georgiboy - this code allows me to enter different photos but it seems to place the first photo in relation to where the command button is located (just underneath it) and then offsets the next photos that I enter. Thanks for the reply though.

 

[Georgiboy]

I was working with the range in the example C:G

Have you made the new image span more columns?

You could try changing this line:

Set rng = shp.BottomRightCell.Offset(1, -4)

To

Set rng = shp.BottomRightCell.Offset(1, -7)

 

[trevolly]

Ahhh that works better - thank you @Georgiboy - Ill continue playing to fine tune it now I see how its working. Thanks for the guidance

Trevor

 

[Georgiboy]

You are welcome, just for reference:

.Width = rng.Resize(, 5).Width

The 5 above sets the picture to be 5 columns in width