#NAME Error in Image hyberlink

[Ramadan]

I'm working on office 2021 and I have a table for the cleints data where i need to store each client's ID in external folder with the same number of the client number in the table in column "B" like 1, 2, 3. 77, 189 etc... with a link in the table column "O" for that image so that I can display the client's ID from the table once click on the that hyberlink

When I faced that before in another sheet, a friend suggested to add this below function in VBA Module and to create the formula in the table column "O" to show to image link and it's ok working perfectly

Now I coppied the same function to the new sheet VBA module and also the formula with changing the folder path but it gives me #NAME error

this is the formula that I use

=HYPERLINK(imgPath("D:\Desktop\ClientsIDs",TEXT(B8,"000")),B8)

here is the function in the modue

Function imgPath(path, imgNum As String)
    Dim imgNameWithExtension As String
    imgNameWithExtension = Dir(path & imgNum & ".*") 'Using multiple wildcards character (*)to get any extension.
        If imgNameWithExtension <> "" Then
        imgPath = path & imgNameWithExtension
    Else
        imgPath = CVErr(xlErrName) 'Dir() returns a zero-length string ("") if file wasn't found, in which case imgPath() returns an error.
    End If
End Function

 

[Micron]

Pretty sure you cannot call a function from a cell when the function is in a sheet module. It has to be in a standard module, and the procedure cannot be a sub either.

 

[Ramadan]

Pretty sure you cannot call a function from a cell when the function is in a sheet module. It has to be in a standard module, and the procedure cannot be a sub either.

@Micron thanks for your notice . however it's actually in a module in my other sheet and it works very good. Now I have changed the formula to be like this =HYPERLINK("D:\Desktop\ClientsIDs\",A1) and the error disappeared but when I push on the cell that has the formula it takes me to the destination folder that contains the images while I need it to open the image itself not to go to the folder

 

[Micron]

Taking you to the location mapped by a hyperlink path is what hyperlinks do, so I think you'd need some other approach. Since you can't cancel the hyperrlink event to prevent following the link, then perhaps
- a cell right click, or
- a key combination you can use to run a sub.
- if you have white space in the cell you could use the BeforeDoubleClick event, which can be cancelled, as in

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 15 Then 'column number for O
    Image1.Picture = LoadPicture("path to picture here")
    Cancel = True
End If

End Sub

The above assumes you are using an ActiveX image control on your sheet, or perhaps in a user form, and that your hyperlinks are in the 15th column.
You could use a cell reference if the cell contains the full path instead of coding the path as I did (for testing purposes).

 

[Ramadan]

Taking you to the location mapped by a hyperlink path is what hyperlinks do, so I think you'd need some other approach. Since you can't cancel the hyperrlink event to prevent following the link, then perhaps
- a cell right click, or
- a key combination you can use to run a sub.
- if you have white space in the cell you could use the BeforeDoubleClick event, which can be cancelled, as in

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 15 Then 'column number for O
    Image1.Picture = LoadPicture("path to picture here")
    Cancel = True
End If

End Sub

The above assumes you are using an ActiveX image control on your sheet, or perhaps in a user form, and that your hyperlinks are in the 15th column.
You could use a cell reference if the cell contains the full path instead of coding the path as I did (for testing purposes).

@Micron thanks for your suggestion but unfortunately I can't get what do you wnat me exactly to do !

 

[Micron]

Are you using an activex control for the picture or not? What did you try?

 

[Ramadan]

Are you using an activex control for the picture or not? What did you try?

@Micron No I don't use Activex image control but just added my above code to the module and then the Hyberlink formula in the table cells 'O" and it appears as you can see in the below screenshot but my probelm is that when I click on the hyberlink cell it takes me to the images folder where I saved images while I need to open the image itelf

like what happen in my other sheet, that's all

 

[Micron]

In post 5 I stated that my suggestion was based on you using an ActiveX control. Did you not read that?

it takes me to the destination folder

That means your path is incomplete or just wrong. One like this should work (Folder path\filename):

LoadPicture ("C:\Users\Micron\Pictures\Califonria2013\img_0003.jpg")

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

LoadPicture ("C:\Users\Micron\Pictures\Califonria2013\img_0003.jpg")

End Sub

 

[Ramadan]

In post 5 I stated that my suggestion was based on you using an ActiveX control. Did you not read that?

That means your path is incomplete or just wrong. One like this should work (Folder path\filename):

LoadPicture ("C:\Users\Micron\Pictures\Califonria2013\img_0003.jpg")

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

LoadPicture ("C:\Users\Micron\Pictures\Califonria2013\img_0003.jpg")

End Sub

@Micron thanks any way for trying to help I think that there is misunderstanding between us I said I don't use Activex and don't want to use it because my issue is much simple for all that and I have it working on other sheet and in your last code I see that you specified the file name as img_0003.jpg why only jpg ! and only img number 0003! is that mean all cells will only open imge No. 3? . however it doen't work thanks again. I think I will aceept it as it opening just the folder

 

[Jaafar Tribak]

Maybe something like this could work for you. It uses the same hyperlink rollover trick to detect the mouse hover:

Workbook Example:
HyperlinkToPicture.xlsm

This is the rollover function I used:
Function RollOverImage( _
ByVal imgFilePathName As String, _
ByVal imgDisplayAnchorCell As Range, _
Optional ByVal imgWidth As Long, _
Optional ByVal imgHeight As Long _
)

Example of use in a worksheet cell:
=IFERROR(HYPERLINK(RollOverImage(B3,I3),A3),A3)
Where Cell B3 has the image file pathname, Cell I3 has the anchored cell over which the image is to be displayed and Cell A3 is the name that is displayed as the Hyperlink text.

The two last Optional arguments in the RollOverImage function correspond to the desired rendered image size (Width & Height) and they default to 100 pix X 100 pix ... Min 100 pix, Max 200pix.

Should work with all formats\types of images files (bmp, jpeg,png, jfif, ico etc) as it uses the GDIPlus api.

Note: You can, but you don't have to Click on the hyperlink in order to display the picture .... Just hovering over is enough.






In a Standard Module:

Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

#If VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Any, ByVal bErase As Long) As Long

    ' GDI+ x64bit API functions
    Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As Long
    Private Declare PtrSafe Function GdipLoadImageFromFile Lib "GDIPlus" (ByVal sFileName As LongPtr, hImage As LongPtr) As Long
    Private Declare PtrSafe Function GdipCreateFromHDC Lib "GDIPlus" (ByVal hDC As LongPtr, hGraphics As LongPtr) As Long
    Private Declare PtrSafe Function GdipDrawImageRectI Lib "GdiPlus.dll" (ByVal graphics As LongPtr, ByVal img As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long) As Long
    Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long
    Private Declare PtrSafe Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As LongPtr) As Long
    Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As Long

#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
    Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Any, ByVal bErase As Long) As Long

    ' GDI+ 32bit API functions
    Private Declare Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As Long
    Private Declare Function GdipLoadImageFromFile Lib "GDIPlus" (ByVal sFileName As LongPtr, hImage As LongPtr) As Long
    Private Declare Function GdipCreateFromHDC Lib "GDIPlus" (ByVal hDC As LongPtr, hGraphics As LongPtr) As Long
    Private Declare Function GdipDrawImageRectI Lib "GdiPlus.dll" (ByVal graphics As LongPtr, ByVal img As LongPtr, ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long) As Long
    Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long
    Private Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As LongPtr) As Long
    Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As Long
#End If

Private Type POINTAPI
    X       As Long
    Y       As Long
End Type

Private Type RECT
    Left            As Long
    Top             As Long
    Right           As Long
    Bottom          As Long
End Type

Private Type GdiplusStartupInput
    GdiplusVersion            As Long
    DebugEventCallback        As LongPtr
    SuppressBackgroundThread  As LongPtr
    SuppressExternalCodecs    As Long
End Type


Public Function RollOverImage( _
    ByVal imgFilePathName As String, _
    ByVal imgDisplayAnchorCell As Range, _
    Optional ByVal imgWidth As Long, _
    Optional ByVal imgHeight As Long _
)

    Static bLooping As Boolean
    Dim oTargetCell As Range, oCurHoveredObject As Object
    Dim uCurPos As POINTAPI
 
    Set oTargetCell = Application.Caller
 
    GetCursorPos uCurPos
 
    If InStr(oTargetCell.Formula, "HYPERLINK(RollOverImage") Then
        If bLooping = False Then
            Do
                bLooping = True
                DoEvents
                GetCursorPos uCurPos
                Set oCurHoveredObject = ActiveWindow.RangeFromPoint(uCurPos.X, uCurPos.Y)
                If TypeName(oCurHoveredObject) = "Nothing" Then Exit Do
                If oTargetCell.Address <> oCurHoveredObject.Address Then Exit Do
                Call DrawImageToSreenDC(imgFilePathName, imgDisplayAnchorCell, imgWidth, imgHeight)
            Loop
            InvalidateRect NULL_PTR, ByVal 0&, 0&
        End If
        bLooping = False
    End If

End Function

Private Sub DrawImageToSreenDC( _
    ByVal imgPath As String, _
    ByVal imgAnchorRange As Range, _
    Optional ByVal imgWidth As Long = 100&, _
    Optional ByVal imgHeight As Long = 100& _
)

    Dim uGdiInput As GdiplusStartupInput, uAnchorRangeRect As RECT
    Dim gdiplusToken As LongPtr
    Dim image As LongPtr
    Dim hGraphics As LongPtr
    Dim hDC As LongPtr
    Dim lRet As Long
 
    On Error GoTo CleanUp
 
    uAnchorRangeRect = GetRangeRect(imgAnchorRange)
 
     ' Initialize GDI+
    uGdiInput.GdiplusVersion = 1&
    lRet = GdiplusStartup(gdiplusToken, uGdiInput)
 
    If lRet <> 0& Then
        MsgBox "Failed to initialize GDI+"
        Exit Sub
    End If
 
    lRet = GdipLoadImageFromFile(StrPtr(imgPath), image)
    If lRet <> 0& Then
        MsgBox "[Image invalid or doesn't exist]" & vbLf & vbLf & _
        "Make sure the Image file path in the 'Hyperlink' Function is correct."
        GdiplusShutdown gdiplusToken
        Exit Sub
    End If
 
    hDC = GetDC(NULL_PTR)
    GdipCreateFromHDC hDC, hGraphics
 
    With WorksheetFunction
        imgWidth = .Max(100&, .Min(200&, imgWidth))
        imgHeight = .Max(100&, .Min(200&, imgHeight))
    End With
 
    With uAnchorRangeRect
        GdipDrawImageRectI hGraphics, image, .Left + 10&, .Bottom - 10&, imgWidth, imgHeight
    End With
 
CleanUp:
    ' Cleanup Graphic Objects
    GdipDisposeImage image
    GdipDeleteGraphics hGraphics
    ReleaseDC NULL_PTR, hDC
    GdiplusShutdown gdiplusToken
 
End Sub

Private Function ScreenDPI(ByVal bVert As Boolean) As Long
    Const LOGPIXELSX As Long = 88&, LOGPIXELSY As Long = 90&
    Static lDPI(1) As Long, hDC As LongPtr
    If lDPI(0&) = 0& Then
        hDC = GetDC(NULL_PTR)
        lDPI(0&) = GetDeviceCaps(hDC, LOGPIXELSX)
        lDPI(1&) = GetDeviceCaps(hDC, LOGPIXELSY)
        hDC = ReleaseDC(NULL_PTR, hDC)
    End If
    ScreenDPI = lDPI(Abs(bVert))
End Function

Private Function PTtoPX(Points As Double, bVert As Boolean) As Long
    Const POINTS_PER_INCH = 72&
    PTtoPX = Points * ScreenDPI(bVert) / POINTS_PER_INCH
End Function
 
Private Function GetRangeRect(ByVal Rng As Range) As RECT
    Dim oPane  As Pane
    Set oPane = Rng.Parent.Parent.Windows(1&).ActivePane
    With GetRangeRect
        .Left = oPane.PointsToScreenPixelsX(Rng.Left - 1&)
        .Top = oPane.PointsToScreenPixelsY(Rng.Top)
        .Right = oPane.PointsToScreenPixelsX(Rng.Left + Rng.Width)
        .Bottom = oPane.PointsToScreenPixelsY(Rng.Top + Rng.Height)
    End With
End Function

Hope this helps.