HYPERLINK to display images

R

ray_b

New Member
Joined
Dec 25, 2015
Messages
34
Hi all;

I have been going through multiple examples on the web over the week trying to get this working to no avail.. Throwing in the towel and asking for some help!

Here's what I am looking for:

Select a stock ticker (and its region) to display a specific chart. It would look like something like this:

1576695795797.png


I have these two (2) issues:

1) Can't (even) HYPERLINK, CONCATENATE to get a link Excel recognizes. I tried the followings:

a) =HYPERLINK(CONCATENATE(D5,$D$2,D6,$D$3,D7))

b) =HYPERLINK("Stockwatch"
&$D$2
&"&region="
&$D$3
&"&d1=20190819&d2=20191218&per=d&npdivs=20&width=830&priceheight=400&ptype=candle&indheight=100&log=F&ind1=none&ind2=none&ind3=vol&ind1p1=12&ind1p2=26&ind1p3=9"
&"&ind2p1=12&ind2p2=25&ind2p3=50&ind3p1=12&ind3p2=25&ind3p3=50&pov1=mae&pov2=mae&pov3=mas&pov1p1=50&pov1p2=&pov2p1=8&pov2p2=&pov3p1=20&pov3p2=&newsInd=T")
(note: last part was split in 2 to avoid the 255 characters limit).

Both options return to: #VALUE!

Whole link for the current chart is: https://www.stockwatch.com/Chart/Hi...&pov2p1=8&pov2p2=&pov3p1=20&pov3p2=&newsInd=T


2) Displaying the image

I have read that a VBA code would be required to achieve such display. Is this true? If so, would anyone have any idea what this code could look like? I mostly have no experience in coding.

Thanks.

Wishing you all the peace and joy in this Holidays Season.
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
This is probably an over engineered way of doing it, but here goes. There are a lot of subroutines and functions in the code below. The one that you will need using is the 'HyperPic' function.

Hit Alt+F11 to get into the VBA editor.
Hit Alt+I+M to insert a new module.
Then paste the code below.

Back in your sheet you'll enter the formula like =HyperPic(A2). The code will download the picture and insert it into the cell where the formula is. The picture is downloaded to the temp folder on the C drive, and after it's inserted into the sheet, the downloaded file is deleted from your hard drive.

VBA Code: 
Public lCnt     As Long
Public gCNT     As Long

Private 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
    
Sub InsertPic(filePath As String, ByVal insertCell As Range)
    Dim xlShapes As Shapes
    Dim xlPic As Shape
    Dim xlWorksheet As Worksheet

    If IsEmpty(filePath) Or Len(Dir(filePath)) = 0 Then
        MsgBox ("File Path invalid")
        Exit Sub
    End If

    Set xlWorksheet = ActiveSheet
    
    Set xlPic = xlWorksheet.Shapes.AddPicture(filePath, msoFalse, msoCTrue, insertCell.Left, insertCell.Top, insertCell.Width, insertCell.Height)
    xlPic.Placement = xlMoveAndSize
    xlPic.LockAspectRatio = msoCTrue
End Sub

Sub DownLoadPic(sURL As String)
Dim sFile As String: sFile = "C:\TEMP\Temp.jpg"
Dim ret As Long: ret = URLDownloadToFile(0, sURL, sFile, 0, 0)

If ret Then
    MsgBox "Failed to Load Picture", vbExclamation
    Exit Sub
End If
End Sub

Function HyperPic(r As Range)
Dim url As String: url = r.Value
Dim sFile As String: sFile = "C:\TEMP\" & rFileName() & ".jpg"
Dim ret As Long: ret = URLDownloadToFile(0, url, sFile, 0, 0)

If ret Then
    MsgBox "Failed to Load Picture", vbExclamation
    Exit Function
End If

InsertPic sFile, r.Offset(, 1)
HyperPic = vbNullString
Kill sFile
End Function

Function rFileName() As String
Dim ch As String: ch = "ABCDEFGHIJKLMNOP0123456789"
Dim sp() As String: sp = Split(StrConv(ch, vbUnicode), Chr(0))
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
ReDim Preserve sp(0 To UBound(sp) - 1)
Dim ri As Integer

For i = 0 To UBound(sp)
    AL.Add sp(i)
Next i

For j = 1 To 16
    ri = Int((AL.Count - 1) * Rnd())
    rFileName = rFileName & AL(ri)
    AL.removeat (ri)
Next j


End Function

Book1
AB
1Link
2https://images-na.ssl-images-amazon.com/images/I/61DnmAI5uwL._AC_UL160_SR160,160_.jpg 
Sheet1
Cell Formulas
RangeFormula
B2B2=HyperPic(A2)
 
Upvote 0
lrobbo314;

Woww....this is quite the code and it works! Thank you enormously for that.

Questions:

1) The downloaded image fits in a cell though. Is there a way to get it downloaded and inserted with its actual dimensions instead of having it fit inside the cell? Or should I just resize the cell? I have different chart sizes to download and would like, if possible, to avoid doing that.

2) Do you have any idea how to resolve my link problem (link in cell A2 that Excel can recognize)? When I CONCATENATE I get a link but Excel doesn't recognize it. Then I used the CONCATENATE inside the HYPERLINK function and then always get #VALUE! .

3) If there is no link in A2 or the link returns to an Error, is there a way to get the previously downloaded chart to clear itself off?

Other than that, I am amazed how well this code works. And it is pretty fast too.


Thank you very much for your time and efforts helping me on this matter.
 
Upvote 0
The problem with the 'Hyperlink' function is that it has a max limit of 255 characters. You run the following code to convert your long url to a hyperlink. Make sure you have the cell selected before running this code.

VBA Code: 
Sub CreateLink()
ActiveCell.Hyperlinks.Add ActiveCell, ActiveCell.Value
End Sub

Also, I decided to move away from a UDF and just use subroutines.

Here is the updated code.

VBA Code: 
Public lCnt     As Long
Public gCNT     As Long
Public Hist     As Object
Public pic      As Object

Private 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

Sub Main()
If Hist Is Nothing Then Set Hist = CreateObject("System.Collections.ArrayList")
If Not pic Is Nothing Then pic.Delete
HyperPic Range("D9")

End Sub

Sub InsertPic(filePath As String)

    If IsEmpty(filePath) Or Len(Dir(filePath)) = 0 Then
        MsgBox ("File Path invalid")
        Exit Sub
    End If

    Set pic = ActiveSheet.Pictures.Insert(filePath)
    pic.Left = 205.5
    pic.Top = 166.5
End Sub

Sub DownLoadPic(sURL As String)
Dim sFile As String: sFile = "C:\TEMP\Temp.jpg"
Dim ret As Long: ret = URLDownloadToFile(0, sURL, sFile, 0, 0)

If ret Then
    MsgBox "Failed to Load Picture", vbExclamation
    Exit Sub
End If
End Sub

Sub HyperPic(r As Range, Optional oLink As String)
Dim url As String: url = r.Value
Dim sFile As String: sFile = "C:\TEMP\" & rFileName() & ".jpg"
Dim ret As Long

If Len(oLink) > 0 Then
    ret = URLDownloadToFile(0, oLink, sFile, 0, 0)
Else
    ret = URLDownloadToFile(0, url, sFile, 0, 0)
End If

If ret Then
    MsgBox "Failed to Load Picture", vbExclamation
    If Hist.Count > 0 Then
        HyperPic r, Hist(Hist.Count - 1)
        Exit Sub
    End If
End If

InsertPic sFile
If Len(oLink) > 0 Then
    If Not Hist.contains(oLink) Then Hist.Add oLink
Else
    If Not Hist.contains(r.Value) Then Hist.Add r.Value
End If
'HyperPic = vbNullString
Kill sFile
End Sub

Function rFileName() As String
Dim ch As String: ch = "ABCDEFGHIJKLMNOP0123456789"
Dim sp() As String: sp = Split(StrConv(ch, vbUnicode), Chr(0))
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
ReDim Preserve sp(0 To UBound(sp) - 1)
Dim ri As Integer

For i = 0 To UBound(sp)
    AL.Add sp(i)
Next i

For j = 1 To 16
    ri = Int((AL.Count - 1) * Rnd())
    rFileName = rFileName & AL(ri)
    AL.removeat (ri)
Next j


End Function

And, the way it gets triggered is by a worksheet event. Right click on the tab that says the sheet name on it. Then click 'View Code'. Then paste the code below. Let me know if you have any questions.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D2")) Is Nothing Then Main
End Sub
 
Upvote 0
Hmmm.. I must be doing something wrong. Here's what I get.

Also, I still need these links to be put together (with info in 5 different cells). Am I still using the HYPERLINK function for that?


1576786867329.png
 
Upvote 0
The easiest way to copy the code is to select the "page" icon top right of the code window.

1576787879393.png
 
Upvote 0
I had it copied in another module (the one that was on the back). I deleted it and copied it in the same module.

I'm still not sure to really follow you. How the code knows what info is to be put together? Do I still have to use the HYPERLINK function somewhere? The function still returns #VALUE! .


1576788703323.png
 
Upvote 0
I replicated the data you have in your OP.

Book1
ABCDEFGHIJKLMNOP
1
2SymbolAAPL
3RegionU
4
5Link Part 1https://www.stockwatch.com/Chart/Hist?symbol=
6Link Part 2&region=
7Link Part 4&d1=20190819&d2=20191218&per=d&npdivs=20&width=830&priceheight=400&ptype=candle&indheight=100&log=F&ind1=none&ind2=none&ind3=vol&ind1p1=12&ind1p2=26&ind1p3=9 &ind2p1=12&ind2p2=25&ind2p3=50&ind3p1=12&ind3p2=25&ind3p3=50&pov1=mae&pov2=mae&pov3=mas&pov1p1=50&pov1p2=&pov2p1=8&pov2p2=&pov3p1=20&pov3p2=&newsInd=T
8
9Whole Linkhttps://www.stockwatch.com/Chart/Hist?symbol=AAPL&region=&d1=20190819&d2=20191218&per=d&npdivs=20&width=830&priceheight=400&ptype=candle&indheight=100&log=F&ind1=none&ind2=none&ind3=vol&ind1p1=12&ind1p2=26&ind1p3=9 &ind2p1=12&ind2p2=25&ind2p3=50&ind3p1=12&ind3p2=25&ind3p3=50&pov1=mae&pov2=mae&pov3=mas&pov1p1=50&pov1p2=&pov2p1=8&pov2p2=&pov3p1=20&pov3p2=&newsInd=T
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sheet1
Cell Formulas
RangeFormula
D9D9=D5&D2&D6&D7


Forget the 'CreateLink' function. I've incorporated it into the code below. You will copy the code below and paste it into a standard module. When you copy it, do not copy the part that says "VBA Code:". @Fluff explained how to easily copy the code.

VBA Code: 
Public lCnt     As Long
Public gCNT     As Long
Public Hist     As Object
Public pic      As Object

Private 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

Sub Main()
If Hist Is Nothing Then Set Hist = CreateObject("System.Collections.ArrayList")
If Not pic Is Nothing Then pic.Delete
HyperPic Range("D9")

End Sub

Sub InsertPic(filePath As String)

    If IsEmpty(filePath) Or Len(Dir(filePath)) = 0 Then
        MsgBox ("File Path invalid")
        Exit Sub
    End If

    Set pic = ActiveSheet.Pictures.Insert(filePath)
    pic.Left = 205.5
    pic.Top = 166.5
End Sub

Sub DownLoadPic(sURL As String)
Dim sFile As String: sFile = "C:\TEMP\Temp.jpg"
Dim ret As Long: ret = URLDownloadToFile(0, sURL, sFile, 0, 0)

If ret Then
    MsgBox "Failed to Load Picture", vbExclamation
    Exit Sub
End If
End Sub

Sub HyperPic(r As Range, Optional oLink As String)
Dim url As String: url = r.Value
Dim sFile As String: sFile = "C:\TEMP\" & rFileName() & ".jpg"
Dim ret As Long

If Len(oLink) > 0 Then
    ret = URLDownloadToFile(0, oLink, sFile, 0, 0)
Else
    ret = URLDownloadToFile(0, url, sFile, 0, 0)
End If

If ret Then
    MsgBox "Failed to Load Picture", vbExclamation
    If Hist.Count > 0 Then
        HyperPic r, Hist(Hist.Count - 1)
        Exit Sub
    End If
End If

InsertPic sFile
If Len(oLink) > 0 Then
    If Not Hist.contains(oLink) Then Hist.Add oLink
Else
    If Not Hist.contains(r.Value) Then Hist.Add r.Value
End If
r.Hyperlinks.Add r, r.Value
Kill sFile
End Sub

Function rFileName() As String
Dim ch As String: ch = "ABCDEFGHIJKLMNOP0123456789"
Dim sp() As String: sp = Split(StrConv(ch, vbUnicode), Chr(0))
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
ReDim Preserve sp(0 To UBound(sp) - 1)
Dim ri As Integer

For i = 0 To UBound(sp)
    AL.Add sp(i)
Next i

For j = 1 To 16
    ri = Int((AL.Count - 1) * Rnd())
    rFileName = rFileName & AL(ri)
    AL.removeat (ri)
Next j
End Function

Then, in order to have the code fire each time you change the Symbol value in D2, you need to paste the sheet_event code. So like I said before, you will right click on the tab that has the sheet name, e.g. "Sheet1", then click 'View Code', and then paste the code below.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D2")) Is Nothing Then Main
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
HYPERLINK function Issue
Replies
2
Views
441
ray_b
R
R
  • Question
HYPERLINK - How to get around the 255 characters limit? _(VBA)
Replies
2
Views
1K
ray_b
R

Forum statistics

Threads
1,215,139
Messages
6,123,262
Members
449,093
Latest member
Vincent Khandagale

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top