Insert specific image from folder

[alexg7828]

Hi Guy's..... I'm Stuck!!

Basically I am making a template for a report generator. The reports contain several images, the images are stored in a file tree that will be the same for each report just the master folder different. The issue is that the image name is not always the same.

I want to be able to press either a link or a button that will then select "insert image" then copy the folder path from a cell in my worksheet then i will manually choose the image to insert.

It would be easy if the images were all named in a specific way but they are not which is where i get lost.

My original idea was to create a hyperlink to the destination folder then drag and drop the image but you can't drag and drop images into excel !! CRAZY !!

Any help much appreciated

 

[Worf]

Welcome to the Forum

' sheet module
Private Sub CommandButton1_Click()
Dim fname$
With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = [e11]                    ' path from cell
    .Filters.Clear
    .Filters.Add "JPEGS", "*.jpg; *.jpeg"
    .Filters.Add "GIF", "*.GIF"
    .Filters.Add "Bitmaps", "*.bmp"
    .AllowMultiSelect = 0
    If .Show = True Then
        fname = .SelectedItems(1)
    Else
        MsgBox "Operation Cancelled"
        Exit Sub
    End If
End With
ActiveSheet.Pictures.insert (fname)
End Sub

 

[alexg7828]

Amazing!!

That's exactly what I was after.

The image imports to a group of cells that have been merged together, I am now trying to automatically scale the image to fit in the cells and centre itself. I would also like to run the macro once the merged cell has been selected so there is no need to have a button.

Any help much appreciated

 

[Worf]

Like this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim fname$, pic, tc As Range
If Not (Target.Cells.Count > 1 And Target.MergeCells) Then Exit Sub
With Application.FileDialog(1)
    .InitialFileName = [e11]
    .Filters.Clear
    .Filters.Add "JPEGS", "*.jpg; *.jpeg"
    .Filters.Add "GIF", "*.GIF"
    .Filters.Add "Bitmaps", "*.bmp"
    .AllowMultiSelect = 0
    If .Show = True Then
        fname = .SelectedItems(1)
    Else
        MsgBox "Operation Cancelled"
        Exit Sub
    End If
End With
Set pic = ActiveSheet.Pictures.insert(fname)
Set tc = Target.Cells(1, 1)
Select Case (pic.Height / pic.Width) / (Target.Height / Target.Width) >= 1
    Case True                        ' picture is tall
        pic.Height = Target.Height
        pic.Left = tc.Left + (tc.MergeArea.Width - pic.Width) / 2
    Case False
        pic.Width = Target.Width
        pic.Top = tc.Top + (tc.MergeArea.Height - pic.Height) / 2
End Select
End Sub

 

[alexg7828]

Stupid question but how do i run the Private Sub? or do i add it on to the end of the previous code?

Thanks

 

[Worf]

- Paste the code on the worksheet module
- When clicking the merged cells it will run automatically

 

[alexg7828]

Thats brilliant !

However within the sheet I have 10 different merged cell ranges, each of the merged cells contains the file path of the image i want to insert there. At the moment when i click on any merged cells it refers back to one specific cell.

Is it possible to use the selected cell as the file path/image location. I.e. if i click on A67 use A67 as the file path to then select the image, if i click on A89 use A89 as the file path.

Can't thank you enough for this help !!

 

[alexg7828]

I've eventually managed to do something for myself and worked the above out ! Thanks for all the help!