Can't get it to work..Please help with pics

[auto998]

Hello,
I have been looking into this for awhile. I have a very basic knowledge with excel 2003.
I got an excel (2003) file that have over 15,000 links to pics. Every cell has one link to a pic <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
(www.pic.com). Is there an easy way to make those links to become pics. In other word every cell that has a link will replace the link with a pic? Thanks for the help<o></o>

 

[Datsmart]

A workbook with over 15,000 pictures will be very large.
I don't think you will like the results of such a bloated file.

 

[auto998]

Thanks, I can have them split into 5 files. But I can't have less than 3000 per file. Is there a way to do it with 3,000?

 

[EducatedFool]

Try

Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Function DownLoadFile(FromPathName As String, ToPathName As String) As Boolean
    DownLoadFile = URLDownloadToFile(0, FromPathName, ToPathName, 0, 0) = 0
End Function

Sub Main()
    On Error Resume Next
    Dim sh As Worksheet: Set sh = ActiveSheet
    Dim cell As Range, ra As Range: Application.ScreenUpdating = False
    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        InsertPhoto cell.Hyperlinks(1).Address, cell
        If cell.Row > 15 Then End
        If cell.Row Mod 3 = 0 Then Application.ScreenUpdating = True: Application.ScreenUpdating = False
    Next cell
End Sub

Sub InsertPhoto(ByVal PhotoPath As String, cell As Range)
    Dim Filename As String
    Filename = Replace(Environ(24), "TEMP=", "") & "\temppic"
    On Error Resume Next: Kill Filename

    If DownLoadFile(PhotoPath, Filename) Then
        cell.EntireColumn.ColumnWidth = 20: cell.EntireRow.RowHeight = 70
        Dim ph As Picture: Set ph = cell.Parent.Pictures.Insert(Filename)
        ph.Top = cell.Top: ph.Left = cell.Left
        ph.Width = cell.Width: ph.Height = cell.Height
        cell = ""
    Else
        cell = "Pictire is not available"
    End If
End Sub

Sub DelPics()
    Dim sha As Shape: Application.ScreenUpdating = False
    For Each sha In ActiveSheet.Shapes
        If sha.Name Like "Picture*" Then sha.Delete
    Next sha
End Sub

 

[auto998]

Thanks. However the code did not work, with my limited knowledge I might have made a mistake. <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
I opened the excel file that have the pic links -> right clicked on sheet1 -> I pasted the code and finally I pressed alt and Q. Nothing happened ....Is that correct? <o></o>

 

[EducatedFool]

I opened the excel file that have the pic links -> right clicked on sheet1 -> I pasted the code and finally I pressed alt and Q. Nothing happened ....Is that correct?

No.
The code needs to be placed in the standart code module.
See the sample file: http://excelvba.ru/XL_Files/Sample__30-08-2009__6-24-38.zip


The result is:

 

[auto998]

EducatedFool, that is exactly what I am looking for. Thank you very much. I have 2 questions:<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
1- When I used your file, it worked just fine. However when I tried to do it myself (again, I not experienced with this at all) it did not work. I opened the excel file that have the pic links -> right clicked on sheet1 -> click on view code -> inserted a Module -> I pasted your code, and finally I pressed alt and Q. Nothing happened, I am not sure what I am doing wrong here.<o></o>
<o> </o>
2- Can have 2 columns that show pics?<o></o>
<o> </o>
Thanks again

 

[EducatedFool]

I pasted your code, and finally I pressed alt and Q

You need to run a macro. Pasting my code into your workbook is not enough

Can have 2 columns that show pics

Worksheet may contains any number of columns.

Send me your workbook to

I'll try to adapt the code to your file.

 

[auto998]

Thanks EducatedFool, I'll send you the file tomorrow. Also could you please walk me through the steps to install your code and get it running... I am going crazy here