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

auto998

New Member
Joined
Aug 28, 2009
Messages
14
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-com:eek:ffice:eek:ffice" /><o:p></o:p>

(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:p></o:p>
 

Datsmart

Well-known Member
Joined
Jun 19, 2003
Messages
7,985
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

New Member
Joined
Aug 28, 2009
Messages
14
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

Active Member
Joined
Jun 10, 2009
Messages
272
Try
Rich (BB code):
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
 
Last edited:

auto998

New Member
Joined
Aug 28, 2009
Messages
14
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-com:eek:ffice:eek:ffice" /><o:p></o:p>
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:p></o:p>
 

auto998

New Member
Joined
Aug 28, 2009
Messages
14
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-com:eek:ffice:eek:ffice" /><o:p></o:p>
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:p></o:p>
<o:p> </o:p>
2- Can have 2 columns that show pics?<o:p></o:p>
<o:p> </o:p>
Thanks again
 

EducatedFool

Active Member
Joined
Jun 10, 2009
Messages
272
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.
 
Last edited:

auto998

New Member
Joined
Aug 28, 2009
Messages
14
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:eek::eek::eek:
 

Forum statistics

Threads
1,082,576
Messages
5,366,419
Members
400,888
Latest member
Cdim7

Some videos you may like

This Week's Hot Topics

Top