OS and Software > Microsoft Help > [Excel] Add a frame into which user can click and add picture

[Excel] Add a frame into which user can click and add picture

 
Sub test()
    Dim szPicFileName As String
    Dim rFirstRow As Long, rLastRow As Long
    Dim cFirstColumn As Integer, cLastColumn As Integer
     
     '   Get the filename & location of the picture
    szPicFileName = Application.GetOpenFilename()
     
    On Error Resume Next
    Set pic = ActiveSheet.Pictures.Insert(szPicFileName)
    On Error GoTo 0
    If Not pic Is Nothing Then 'Found it!'
         '   Set the range (change the first & last columns & rows to whatever you need)
        rFirstRow = 59
        rLastRow = 60
        cFirstColumn = 2
        cLastColumn = 12
        Set Rng = Range(Cells(rFirstRow, cFirstColumn), Cells(rLastRow, cLastColumn))
        With pic
            .Height = Rng.Height
            .Width = Rng.Width
            .Left = Rng.Left
            .Top = Rng.Top
        End With
    End If
End Sub
 
 

Re: [Excel] Add a frame into which user can click and add pictur

reply to nickstoy
please close. don't need it anymore, we went down an entirely other road

You sure you don't need it now? I know it's been some days, but I probably have code to do this. Matter of fact I did it just recently for a client.
Basically put the frame and size it where you want it to be first, then set up some code to do the work of browsing for and setting up the picture.
I'd put a simple rectangle shape on a sheet and gave it the name myPicture. The code below runs when you click on it (by assigning this macro to the shape).
Since VBA really doesn't know how it got to that routine, I search the active sheet for all shapes and when I find the correct one, I set up the picture in it.

Sub ChooseNewPicture()
  Dim someShape As Shape
  Dim newLogo As String
  Dim myReply As Integer
  
  myReply = MsgBox("Choose New Picture [Yes] or Remove Picture [No]?", _
   vbYesNoCancel + vbQuestion, "Picture Choices")
  Select Case myReply
    Case Is = vbNo
      'remove fill from the logo
      For Each someShape In Sheet1.Shapes
        If someShape.Name = "myPicture" Then
          With someShape.Fill
            .Visible = False
          End With
        End If
      Next
 
    Case Is = vbYes
      newLogo = Application.GetOpenFilename("Graphic Files (*.jpg; *.gif),*.jpg;*.gif", , _
       "Select Logo File")
      If newLogo = "False" Then
        Exit Sub
      End If
      For Each someShape In Sheet1.Shapes
        If someShape.Name = "myPicture" Then
          With someShape.Fill
            .Visible = True
            .UserPicture newLogo
          End With
        End If
      Next
      
    Case Else
      'vbCancel or treat same as vbCancel
      Exit Sub
    End Select
End Sub