Insert image and copy image name to the column over?

[luisgiraldo89]

Hi Guys,

1. I Have this code below. It inserts and re-sizes image to a selected cell. This code works beautifully. I would like to insert the image and insert the image name in the column over.

For example: All my images will be in the column A. So if i choose to put a image in cell A4 i want cell b4 to state the image name. So if the image is call myphoto.jpg i want cell b4 to say "myphoto".?

2. A bonus solution:

Another solution i was looking for is to have a userform with this code where the person can select the cell they want to put the picture in.

For example: Insert picture in cell A5?

3. I really like this code it re-sizes a perfect column width and height so i just want to add this code and insert the above solutions if possible? Also i can donate to anybody willing to help?

Private Sub CommandButton1_Click()
Dim myPicture As String


myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "Select Picture to Import")
If myPicture <> "" Then
ActiveSheet.Pictures.Insert (myPicture)
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Select


With Selection


.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = ActiveCell.RowHeight
.ShapeRange.Width = ActiveCell.Width
.Placement = xlMoveAndSize




End With
End If
End Sub

 

[Kenneth Hobson]

Private Sub CommandButton1_Click()
  Dim myPicture As String, p As Picture, fso As Object
  
  myPicture = Application.GetOpenFilename _
    ("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", _
    , "Select Picture to Import")
  If myPicture = "" Then Exit Sub
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set p = ActiveSheet.Pictures.Insert(myPicture)
  With p
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = ActiveCell.RowHeight
    .ShapeRange.Width = ActiveCell.Width
    .Placement = xlMoveAndSize
    .TopLeftCell.Offset(, 1).Value = fso.GetBaseName(myPicture)
    .TopLeftCell.Offset(, 1).Select
  End With
  Set fso = Nothing
End Sub

 

[luisgiraldo89]

Thank you that was fast!!!!!!!!!!!!!!!!!!! I appreciate the work.