Viewing links through User Form in Excel Databse

[Shazz]

Hi all,

I am really hoping someone can help me with this, I have a Databse I have created with help which also has a user form to add and view data to the spreadsheet, In Text Box 10,11 & 12 you should be able to click the text (which is set up to show as a link) and it takes you to the link, it used to work perfectly fine but since adding code to the database to incorporate a Combo Box to be able to search for a name it does not work and I do not understand why.

I am really desperate to get this database up and running but just can not figure out the problem, I have had alot of help from others with regards to the coding so I can not take the credit for the entire Database unfortunatley.

The password is "test" for the data sheet access.

Please can someone help me!!

Shazz
xx

[Ken Puls]

You have a couple of issues here.
1) You're trying to use a MouseUp event, and should be using a DoubleClick event
2) Your "Data" variable is out of scope (hasn't been set)

Here's code for TextBox11:

Private Sub TextBox11_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim R As Long
    Dim lTB As Long
        
        lTB = 11
        R = CLng(RowNumber)
        Set Data = Worksheets("Data Form")
        
      ' There must be a row number and the user must left click with the mouse.
        If R <> 0 And Len(Me.Controls("TextBox" & lTB).Text) > 0 Then
           On Error Resume Next
              Data.Cells(R, lTB).Hyperlinks(1).Follow True
              If Err <> 0 Then MsgBox "Unable to open '" & Data.Cells(R, lTB).Value & "'."
           On Error GoTo 0
        End If
End Sub

To port this to TextBox12, just change the Private Sub line to TextBox12... and update the lTB variable to 12.

I believe that should get you sorted.

[Shazz]

Thanks for you reply but it is still not working, below is what i ahve changed Text Boxes 10,11 and 12 too, is it correct or have I done something wrong?

Private Sub TextBox10_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim R As Long
    Dim lTB As Long
        
        lTB = 10
        R = CLng(RowNumber)
        Set Data = Worksheets("Data Form")
        
      ' There must be a row number and the user must left click with the mouse.
        If R <> 0 And Len(Me.Controls("TextBox" & lTB).Text) > 0 Then
           On Error Resume Next
              Data.Cells(R, lTB).Hyperlinks(1).Follow True
              If Err <> 0 Then MsgBox "Unable to open '" & Data.Cells(R, lTB).Value & "'."
           On Error GoTo 0
        End If
End Sub

Private Sub TextBox11_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim R As Long
    Dim lTB As Long
        
        lTB = 11
        R = CLng(RowNumber)
        Set Data = Worksheets("Data Form")
        
      ' There must be a row number and the user must left click with the mouse.
        If R <> 0 And Len(Me.Controls("TextBox" & lTB).Text) > 0 Then
           On Error Resume Next
              Data.Cells(R, lTB).Hyperlinks(1).Follow True
              If Err <> 0 Then MsgBox "Unable to open '" & Data.Cells(R, lTB).Value & "'."
           On Error GoTo 0
        End If
End Sub

Private Sub TextBox12_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim R As Long
    Dim lTB As Long
        
        lTB = 12
        R = CLng(RowNumber)
        Set Data = Worksheets("Data Form")
        
      ' There must be a row number and the user must left click with the mouse.
        If R <> 0 And Len(Me.Controls("TextBox" & lTB).Text) > 0 Then
           On Error Resume Next
              Data.Cells(R, lTB).Hyperlinks(1).Follow True
              If Err <> 0 Then MsgBox "Unable to open '" & Data.Cells(R, lTB).Value & "'."
           On Error GoTo 0
        End If
End Sub

[Ken Puls]

What kind of error are you getting back?

[Shazz]

Hi Ken, I am not getting any error, when I click on the text box (Text Box 11 - Engineers Photos) it does nothing, the link works fine on the Datasheet though.

Are you able to make the nessccary correction on the database and attach?

Shazz
xx

[Ken Puls]

Here you go.

FYI, I'm running on a 64bit Office system here, so I had to add a conditional compilation to wrap all your API calls in order to open your project. You can leave them there, but those calls should really be checked before you use this file in a 64 bit environment or it could blow up. As long as you run in 32bit Office though, (just because you run a 64 bit Windows does NOT mean you are running 32bit Office,) you'll be fine.

I get an error telling me that the file couldn't be opened, but that's to be expected as I don't have the file your link points to.

HTH,

[Shazz]

It is still not working on the user form?? does it work for you by clicking the Engineers Photo Link in the Actual User Form?

Shazz
xx

[Ken Puls]

Yes, sure does.

I opened the workbook, clicked "Open Data Form", and clicked "Next" to get to "Test". There is a link in the Engineers Photos there (View Photos). When I double click that it tries to open the file (and fails since I don't have it.)

You're not seeing the same?

[Shazz]

Sorry yes it does work, I did not realise you had to double click, normally for links it is a single click.

Being a bit cheeky here, is there a way to make it single click at all, as the other users probably wont realise either.

Thanks so much for your help, your a star.

Shazz
xx

[Ken Puls]

Okay, so there is no Click event for a textbox, but there is for a button. So what you could do is:
-Create a button that fits right on top of the textbox (I set up CommandButton4 on top of TextBox11)
-Clear it's default caption
-Set it's BackStyle to 0-fmBackStyleTransparent

Now paste in the following code:

Private Sub CommandButton4_Click()
    Dim R As Long
    Dim lTB As Long
        
        lTB = 11
        R = CLng(RowNumber)
        Set Data = Worksheets("Data Form")
        
      ' There must be a row number and the user must left click with the mouse.
        If R <> 0 And Len(Me.Controls("TextBox" & lTB).Text) > 0 Then
           On Error Resume Next
              Data.Cells(R, lTB).Hyperlinks(1).Follow True
              If Err <> 0 Then MsgBox "Unable to open '" & Data.Cells(R, lTB).Value & "'."
           On Error GoTo 0
        End If
End Sub

Private Sub CommandButton4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call CommandButton4_Click
End Sub

At this point you can comment out the old Textbox11 code as it is no longer necessary. Now if you single or double click the button (which is almost invisible on top of your textbox) it will fire the launch.