Excel 2010 VBA Picture Imports - Please help me expand on this code...

[Bret1]

The code below allows me to input a complete picture file name into cell (A2), press the “Refresh” control button, and the picture from the file name is displayed. Each time the “Refresh” button is clicked, it clears the current picture and refreshes the picture from the file name referenced in cell (A2). It also corrects for “Non-existent file name” errors.

I would like to add 2 things to the code:
1 - Allow for a “File Description” name to display in place of the actual “File Name”.
2 - Allow for multiple file name pictures to be displayed.
I would like the ability to select any cell, and click an “Add Picture” control button. Then a pop-up displays requesting “File Name?” and “File Description?”. After completing and selecting “OK”, the “File Description” is displayed in the active cell, and the top left corner of the picture from the file is displayed under the cell. Each time the “Refresh” button is clicked, the pictures are cleared and refreshed from the reference file names to eliminate having multiple layers of hidden pictures.

Thanks for any help!

Here is the code I have that allows for one picture to display from the full file name given in cell (A2)…

 Private Sub cmdDisplayPhoto_Click()Application.ScreenUpdating = False
Dim myObj
Dim Pictur
Set myObj = ActiveSheet.DrawingObjects
For Each Pictur In myObj
If Left(Pictur.Name, 7) = "Picture" Then
Pictur.Select
Pictur.Delete
End If
Next
 
Dim PictureName As String
PictureName = Range("A2")
 
On Error GoTo errormessage:
ActiveSheet.Shapes.AddPicture Filename:=PictureName, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=190, Top:=30, Width:=300, Height:=300
 
errormessage:
If Err.Number = 1004 Then
MsgBox "File does not exist." & vbCrLf & "Check the filename again"
Range("A2").Value = ""
 
End If
Application.ScreenUpdating = True
End Sub

 

[Worf]

Hi
I don't know of a way to put an image inside a cell, only over it.
Would you like the picture with a text box on top of it?

 

[Bret1]

I don't know enough about VBA to answer to your question. I was able to put my attached code together by watching Youtube videos. However, it does post the one picture from the one link (provided in cell (A2) just as a picture on the page (with the height and width given in the code). I'm guessing that the command it uses to import the picture is the "Avtiveshapes.Shapes.Addpicture" command. After the picture refreshes, you can click on it and drag the corners to resize if you want for a close-up view, or move it around. I want this some thing, but not limited to only one picture filename in cell (A2). I want to have the ability to click anywhere, click an "add picture" control button, add the link to a(nother) picture file name, and have the picture display under the link cell. In the code above, the picture "floats" above several cells. It is not "in" the cells.

 

[JPresbrey]

Hello,

This thread might help you, as I use it to do something similar:

Link Images to Cell output - Microsoft Community

It centers and resizes the image to the keycell (the one with the filename in it). It might help you with positioning, if nothing else

 

[Worf]

Hi
See if this is useful:

' sheet module
Private Sub CommandButton21_Click() ' adds image and a text box
Dim fd$, fn$, ash As Worksheet
fn = Application.InputBox("Enter file name:", , "c:\users", , , , , 2)
fd = Application.InputBox("Enter file description:", , , , , , 2)
Set ash = ActiveSheet
ash.Shapes.AddPicture fn, msoFalse, msoTrue, ActiveCell.Left, ActiveCell.Top, 200, 150
With ash.Shapes.AddTextbox(1, ActiveCell.Left, ActiveCell.Top, 200, 60)
    .TextFrame.Characters.Text = fd                 ' file description over the image
    .TextFrame.HorizontalAlignment = xlHAlignCenter
    .TextFrame.VerticalAlignment = xlVAlignCenter
    .Fill.Transparency = 0.86
    .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = RGB(213, 123, 56)    ' orange
    .TextFrame2.TextRange.Characters.Font.Size = 14
End With
End Sub
Private Sub CommandButton22_Click()  ' refresh button
Dim ob, pictur
Set ob = ActiveSheet.DrawingObjects
For Each pictur In ob
    If Left(pictur.Name, 7) = "Picture" Or pictur.Name Like "*Text*" Then pictur.Delete
Next
End Sub

 

[Bret1]

Worf,
Thank you very much for helping on this!
The "Add Picture" command you created does pretty much exactly what I'm looking for.... It imports the picture(s) from the link provided with the top,left corner in the last active cell position.
However, all the "Refresh Button" seems to do is delete all of the pictures. Would it be possible to make the "Refresh Button" delete the current pictures, then re-load them from their original file names?

Also, is there any way to allow for longer file names? Some of the file names I'm using are very long (up to 330 characters). That's why I was wanting to allow for the "File Description" input.

Thanks again,
Bret

 

[Bret1]

I found this link that appears to be a way around the 255 character limit. But I don't know how to apply it....
excel - Overcome VBA InputBox Character Limit - Stack Overflow

Copied from the link...
To be pedantic, the Inputbox will let you type up to 255 characters, but it will only return 254 characters.
Beyond that, yes, you'll need to create a simple form with a textbox. Then just make a little "helper function" something like:
<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit;">

Function getBigInput(prompt AsString)AsString
    frmBigInputBox.Caption = prompt
    frmBigInputBox.Show
    getBigInput = frmBigInputBox.txtStuff.Text
EndFunction

</code>

 

[Worf]

Hi Bret

Please choose one of the two input methods below:

1) Long string to be retrieved from a sheet cell
2) Long string to be inserted into a user form text box.

 

[Bret1]

Sorry.... Not sure I understand what you are asking.
To best answer your question, I can only tell you what I'm looking for and hopefully that will answer your question.....
Activate any cell, click on "Add picture" command button, some type of form pops up and asks for two inputs... "File name?" (could be over 300 characters for actual picture file location) and "file description?" (shorter reference name to be displayed in place of the actual file name). Pressing "OK" imports the top-left corner of the picture from the "file name" where the active cell was (or one cell below). In a perfect world, the "file description" reference name would appear in the cell(s) just above the top-left corner of the picture. When the "Refresh" button is pressed, all pictures are deleted and refreshed from their original file names in the same locations they were in.

 

[Worf]

Hi
- The following retrieves the image path from a cell that you specify
- It uses invisible text boxes to store information. After a while, if you want to inspect the sheet for invisible objects, go to Ribbon>Organize>Selection Pane

Private Sub CommandButton21_Click()                     ' add picture
Dim fd$, fnc$, ash As Worksheet, ia, ps$, ac As Range
Set ac = ActiveCell
fnc = Application.InputBox("Enter file name cell:", "Example input: D4", "d4", , , , 2)
fd = Application.InputBox("Enter file description:", , , , , , 2)
Set ash = ActiveSheet
ps = ash.Range(fnc).Value
ia = Split(ps, "\")
With ash.Shapes.AddPicture(ps, msoFalse, msoTrue, ac.Left, ac.Top, 200, 150)
    .Name = ia(UBound(ia))
End With
With ash.Shapes.AddTextbox(1, ac.Left, ac.Top, 200#, 90#)
    .Visible = msoFalse
    .TextFrame.Characters.Text = ps & "*" & ac.Address & "*" & ia(UBound(ia))
    .Name = "Tb" & ia(UBound(ia))
End With
ac.Offset(-1).Value = fd
End Sub


Private Sub CommandButton22_Click()         ' refresh pictures
Dim ob, pictur, c$, tba, ash As Worksheet
Set ash = ActiveSheet
Set ob = ash.DrawingObjects
For Each pictur In ob       ' delete first to avoid indexing problems
    If Left(pictur.Name, 7) = "Picture" Then pictur.Delete
Next
For Each pictur In ob
    If pictur.Name Like "Tb*" Then
        tba = Split(ash.Shapes(pictur.Name).TextFrame.Characters.Text, "*")
        With ash.Shapes.AddPicture(tba(0), 0, -1, ash.Range(tba(1)).Left, _
        ash.Range(tba(1)).Top, 200, 150)
            .Name = tba(2)
        End With
    End If
Next
End Sub