Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
How to make a hyperlink using a Rich Text Box
VB Component Trick
One day our support staff came to me and asked if there was anyway they could add hyperlinks to an application that I wrote that utilized a rich text box component. I have had my troubles with hyperlinks before but I thought I would just give it a try. Here is what I came up with. It is a simple click function that returns the hyperlink string and then shells it into IExplore. I hope you find it useful. Give me some feed back
thanks
Scoty :
You will need to start a new project then add the RichTextBox component. Drop a RTB on the form anywhere
then add this code
thanks
Scoty :
You will need to start a new project then add the RichTextBox component. Drop a RTB on the form anywhere
then add this code
Code:
Private Sub Form_Load()
GetThisHyperLink = InputBox("HyperLink?", "Please enter a WebPage", "http:\\www.tek-tips.com")
GetThisHyperLink = Replace(GetThisHyperLink, "\\", "\\\\", 1)
Me.RichTextBox1 = "{\rtf1\ansi\deff0{\fonttbl{\f0\fnil\fcharset0 MS Sans Serif;}}" & Chr(13) & _
"{\colortbl ;\red0\green0\blue255;} " & Chr(13) & _
"\viewkind4\uc1\pard\lang1033\f0\fs17 This would be the non hyperlink beginning of the richtext box \cf1\ul " & GetThisHyperLink & "\cf0\ulnone and this would be the end of the non hyperlink text" & Chr(13) & _
"\par }"
End Sub
Private Sub RichTextBox1_Click()
With Me.RichTextBox1
If .SelColor = vbBlue And .SelUnderline Then
[color green]'find the beginning of the Hyperlink[/color]
For I = .SelStart To 1 Step -1
.SelStart = I
If .SelStart = I then [color green]'sometimes the .SelStart doesn't change..this is the work around[/color]
If Not .SelUnderline Then
Exit For
End If
End If
Next I
StartPos = .SelStart
[color green]'Find the end of the Hyperlink[/color]
For I = .SelStart + 1 To Len(Me.RichTextBox1)
.SelStart = I
If .SelStart = I then [color green]'sometimes the .SelStart doesn't change..this is the work around[/color]
If Not .SelUnderline Then
Exit For
End If
End If
Next I
EndPos = .SelStart - 1
[color green]'Now Scrape HyperLink[/color]
.SelStart = StartPos
.SelLength = EndPos - StartPos
MyHyperLink = .SelText
.SelStart = 1
.SelLength = 0
[color green]'Now launch internet explorer to that page[/color]
Shell """C:\Program Files\Internet Explorer\IExplore.exe """ & MyHyperLink, vbNormalFocus
End If
End With
End Sub