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

 

[Bret1]

Your last code looks great! It appears to be working how I imagined!

I did find three things tho....
It automatically refreshes all the pictures every time the file is first opened. I would rather it not refresh the pictures until the "Refresh" button is pressed. That way I can save the file (with today's date) and go back and view the pictures as they were on that date without it refreshing.

When it currently auto-refreshes the first time when opening, all the pictures refresh into their correct positions. However, each time the Refresh button is pressed, some/several, or all of the pictures move "up" one cell when refreshed. It seems kind of random as to what pictures or how many of them move up when refreshed.

Once I have a "long URL" listed, and the picture is imported, I can't figure out a way to delete that picture, it's description and it's "long URL" without getting an ERROR message...
Run-time error '9':
Subscript out of range

 

[Bret1]

I did some testing to try and figure out why some (or all) of the pictures randomly move "up" one cell after refreshing.
It turns out that when I use "shorter" file names to my c:.../pictures directory, they never move when refreshed.
But, if I add a "long" URL file name to a picture, the "shorter" file name pictures still never move when refreshed, but the picture with the "long" URL did randomly moved up one cell. Maybe it has to do with the length of the URL file name? It's weird that it seems to move up randomly. It doesn't happen every time, or to every picture with a long URL link.

 

[Worf]

Hi
Just to be sure, do you have any other code besides mine on the workbook, especially event code?
At what moment do you get error 9, when deleting or when trying to add/refresh afterwards? What code line is highlighted?

 

[Bret1]

No other code.
I can delete a picture and or the "short" description name on sheet1 and refresh without errors. It just re-populates the picture. If I delete the "Long" link on "Long URLs" page, then go to sheet1 and "Refresh", I get the error.
It highlights "Private Sub Refresh_Click()" line...
If I click debug, it highlights "url.Hyperlinks(CInt(Split(sh.Name, "i")(1))).ScreenTip = sh.TopLeftCell.Address" line.
I don't get the error until I click the "refresh" button.

 

[Bret1]

I do have a short description of the "Long URL" on sheet "Long URLs" also....
Cell A1 may have "APPL Chart", and the Long URL link of "APPL chart" picture is in cell B1.

 

[Worf]

Hi

All considered, I’m proposing another method, a reference table placed at columns P-S (with headers on the first row). Below is the adding code, I’ll post the refresh part later.

Private Sub CommandButton1_Click()      ' add picture
Dim fnc$, fd$, url As Worksheet, lr%


Set url = Sheets("Long URLs")
fnc = Application.InputBox("Enter image address cell", "Example input:D4", , , , , , 2)
fd = Application.InputBox("Enter image description", , , , , , , 2)
lr = url.Range("p" & Rows.Count).End(xlUp).Row + 1
url.Cells(lr, 16) = url.Range(fnc)
url.Cells(lr, 19) = fd
With Sheets("Sheet1").Pictures.Insert(url.Range(fnc))
    .Name = "pic" & "_" & Date & "_" & Time
    url.Cells(lr, 17) = .Name
    url.Cells(lr, 18) = .TopLeftCell.Address
    .Left = ActiveCell.Left
    .Top = ActiveCell.Top
    .Width = 200
    .Height = 150
End With
ActiveCell.Offset(-1) = fd


End Sub

 

[Worf]

Hi Bret

My beautiful Excel 2013 is crashing every time at the insert picture line, so I will test the complete code Monday at work with the good old Excel 2003…

 

[Bret1]

My 2010 version did the same thing. I was going to wait for the "refresh" addition and try again. I thought it might have been something I was setting up wrong.

 

[Bret1]

The last "full" version is working great! I just mainly wish it didn't auto-refresh on every "open" and I could delete one without getting an error on next "refresh". Maybe I can find a "work-around" with the error by deleting one then saving and reopening (or something). Then the only issue would be to make it not refresh at each open. The fact that some move up a cell on refresh is not that critical. It does allow me to move it/them back down a cell.

 

[Worf]

The error 9 issue is an easy fix, it has to do with hyperlink indexing. The auto refresh I have to think about...