Hyperlink link of the Image from userform added wont open

Question

Hi i have userform with the all the data adds to the "VehicleRejected" Sheet from a userform however i have added an code for user to select an image from their drive and it will add the hyperlink to the cell now hyperlink wont open and error message comes up with "Cannot open the Specific file" can someone help me with the code please

   Private Sub CommandButton3_Click()
  On Error GoTo errHandler:
  
  Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("VehicleRejected")
Dim n As Long
Dim answer As String
Dim strFileName As String


Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False
Application.EnableEvents = False

''''''''''''''''''''

n = sh.Range("A" & Application.Rows.Count).End(xlUp).Row

strFileName = Application.GetOpenFilename(filefilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select a File", MultiSelect:=False)

TextBox65 = strFileName  'use to save URL or Link from picture

If strFileName = "False" Then
    MsgBox "File Not Selected!"
    Else
    'load picture to Image control, using LoadPicture property
    Me.Image2.Picture = LoadPicture(strFileName)
    
End If

sh.Unprotect "1234"

sh.Range("i" & n + 1).Value = Me.TextBox65.Value

sh.Range("i" & n + 1).Select
    With ActiveSheet
.Hyperlinks.Add Anchor:=sh.Range("i" & n + 1), Address:=",TextToDisplay, """
End With
  
sh.Protect "1234"

MsgBox "Updated Successfully!!!", vbInformation
Unload Me

Application.EnableEvents = True
Application.ScreenUpdating = True

Worksheets("VehicleRejected").Activate
Worksheets("VehicleRejected").Cells(1, 3).Select

Exit Sub

errHandler:
 MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please Contact Admin", vbCritical, "Error Message"

End Sub

Answer 1

Hi Siddharth with your code and with some other code played around, below is what i have got so far and it adds the hyperlink of the picture however file wont open or found.

Private Sub CommandButton3_Click()
  On Error GoTo errHandler:
  
  Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("VehicleRejected")
Dim n As Long
Dim answer As String
Dim strFileName As String


Application.EnableCancelKey = xlDisabled

Application.ScreenUpdating = False
Application.EnableEvents = False

''''''''''''''''''''

n = sh.Range("A" & Application.Rows.Count).End(xlUp).Row

strFileName = Application.GetOpenFilename(filefilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select a File", MultiSelect:=False)

TextBox65 = strFileName  'use to save URL or Link from picture

If strFileName = "False" Then
    MsgBox "File Not Selected!"
    Else
    'load picture to Image control, using LoadPicture property
    Me.Image2.Picture = LoadPicture(strFileName)
    
End If

sh.Unprotect "1234"

sh.Range("i" & n + 1).Value = Me.TextBox65.Value

sh.Range("i" & n + 1).Select
    With ActiveSheet
.Hyperlinks.Add Anchor:=sh.Range("i" & n + 1), Address:=",TextToDisplay, """
End With
  
sh.Protect "1234"

MsgBox "Updated Successfully!!!", vbInformation
Unload Me

Application.EnableEvents = True
Application.ScreenUpdating = True

Worksheets("VehicleRejected").Activate
Worksheets("VehicleRejected").Cells(1, 3).Select

Exit Sub

errHandler:
 MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please Contact Admin", vbCritical, "Error Message"

End Sub

Answer 2

i want to know if it is possible for image that uploaded on the userform which is in image2 can it be also inserted on to the sheet in column I, J, K , L on same row as the date entered with auto size adjusted.

Yes it is possible. Here is an example. I am going to insert the image in say I10 for demonstration purpose. Feel free to adapt it to suit your need.

Logic:

1. Get user's temp directory.
2. Save the image from the image control to user's temp directory using SavePicture.
3. Insert the image from the temp directory into relevant worksheet.
4. Resize as required.

Code:

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    
    '~~> Change this to the relevant sheet
    Set ws = Sheet1
    
    Dim tempImagePath As String
    tempImagePath = TempPath & "Temp.jpg"
    
    '~~> Save the image to user's temp directory
    SavePicture Image1.Picture, tempImagePath
    
    DoEvents
    
    '~~> Insert the image in cell say I10 and resize it
    With ws.Pictures.Insert(tempImagePath)
        '~~> If LockAspectRatio  is set to true then Height and Width will not change
        '~~> as per cell height and width
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = ws.Range("I10").Left
        .Top = ws.Range("I10").Top
        .Width = ws.Range("I10").Width
        .Height = ws.Range("I10").Height
    End With
End Sub

Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

In Action:

Image attribution