Attach hyperlink to an image

[DarkRevs]

Hi all,

Thank you for taking the time to view my question.

I am looking for a way to attach the hyperlink which i have in my clipboard to an image i add with this code.

Is there any one who can help me out with the last part?

thanks!

Private Sub InsertWord_Click()


Dim clipboardData As New DataObject 'get the info from clipboard
Dim clipboardContents As String 'get the info from clipboard
clipboardData.GetFromClipboard 'get the info from clipboard
clipboardContents = clipboardData.GetText 'get the info from clipboard
 
Dim clLeft As Double 'select the active cell
Dim clTop As Double 'select the active cell
Dim sFile As String 'select the picture to be added
sFile = "C:\Insert Icons\Word.png"


If Dir(sFile) = "" Then
MsgBox "Picture file was not found in path!", , "No such animal"
Exit Sub
End If
Set cl = Range(Selection.Address) 'set active cell
clLeft = cl.Left
clTop = cl.Top


ActiveSheet.Shapes.AddPicture Filename:=sFile, _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoCTrue, _
    Left:=clLeft, Top:=clTop, _
    Width:=12, _
    Height:=12
    
End Sub

 

[yky]

Try this. Add the code to right above End Sub.

Dim sh as Shape
For Each sh in ActiveSheet.Shapes
If sh.Top = clTop and sh.Left=clLeft Then
Exit For
End If
End For

ActiveSheet.Hyperlinks.Add Anchor:=sh, Address:=sText

 

[DarkRevs]

Thanks for your response!

I get a syntax error on the end for line when i paste this aboven my End Sub

 

[yky]

Which line caused the problem?

 

[Jaafar Tribak]

Here is a cleaned up version of your original code:

Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function IsValidURL Lib "URLMON.DLL" (ByVal pbc As Long, ByVal szURL As String, ByVal dwReserved As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function IsValidURL Lib "URLMON.DLL" (ByVal pbc As Long, ByVal szURL As String, ByVal dwReserved As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Private Sub InsertWord_Click()

    Dim cl As Range, oPic As Shape
    Dim clipboardData As Object 'get the info from clipboard
    Dim clipboardContents As String 'get the info from clipboard
    Dim clLeft As Double 'select the active cell
    Dim clTop As Double 'select the active cell
    Dim sFile As String 'select the picture to be added
    Dim lCounter As Long

    Set clipboardData = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    clipboardData.GetFromClipboard

    For lCounter = 1 To UBound(Application.ClipboardFormats)
        If Application.ClipboardFormats(lCounter) = xlClipboardFormatText Then
            If IsValidURL(ByVal 0&, StrConv(clipboardData.GetText(lCounter), vbUnicode), 0) = 0 Then
                clipboardContents = clipboardData.GetText(lCounter)
                Exit For
            Else
                MsgBox "There is no valid URL in the clipboard.", vbCritical
                Exit Sub
            End If
         Else
            MsgBox "There is no valid URL in the clipboard.", vbCritical
            Exit Sub
        End If
    Next lCounter
         
    sFile = "C:\Insert Icons\Word.png"
    sFile = "C:\Users\Info-Hp\Pictures\bbb.png"
    
    If Dir(sFile) = "" Then
        MsgBox "Picture file was not found in path!", , "No such animal"
        Exit Sub
    End If
    
    Set cl = ActiveWindow.RangeSelection
    clLeft = cl.Left
    clTop = cl.Top

    Set oPic = ActiveSheet.Shapes.AddPicture(Filename:=sFile, _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoCTrue, _
    Left:=clLeft, Top:=clTop, _
    Width:=12, _
    Height:=12)
        
    If Not oPic Is Nothing Then
        ActiveSheet.Hyperlinks.Add Anchor:=oPic, Address:=clipboardContents
    End If
End Sub