Code vba lien hypertext depuis un textbox vers un onglet de classeur

Bonjour,

un exemple:

mettre le lien dans la cellule A1 de la feuille sur laquelle s'ouvrira l'UserForm

Option Explicit
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 If Range("A1").Hyperlinks.Count > 0 Then
If TextBox1.Text = Range("A1").Hyperlinks(1).TextToDisplay Then
 With Selection.Hyperlinks(1)
 .Follow NewWindow:=False, AddHistory:=True
 If .SubAddress <> "" Then
 Sheets(Split(.SubAddress, "!")(0)).Select
 Range(Split(.SubAddress, "!")(1)).Select
 End If
 End With
 End If
 End If
End Sub
Private Sub UserForm_Initialize()
TextBox1.Text = Range("A1").Value
End Sub

A adapter

salut cs_le pivert !
je teste ton code et te tiens au courant. en attendant voici mon codage le lien hypertexte fonctionne pour google map mais pas pour mon classeur.

Dim f, choix(), Rng, Ncol

Private Sub TextBox6_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ThisWorkbook.FollowHyperlink link & Me.TextBox6.Text

End Sub

Private Sub TextBox7_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ThisWorkbook.FollowHyperlink link & Me.TextBox7.Text
End Sub

Private Sub UserForm_Initialize()
Set f = Sheets("bd")
Set Rng = f.Range("A3:G" & f.[a65000].End(xlUp).Row)
TblTmp = Rng.Value
Ncol = Rng.Columns.Count
For i = LBound(TblTmp) To UBound(TblTmp)
ReDim Preserve choix(1 To i)
For k = LBound(TblTmp) To UBound(TblTmp, 2)
choix(i) = choix(i) & TblTmp(i, k) & " * "
Next k
Next i
Me.ComboBox1.List = Rng.Value
'---
For i = 1 To Ncol
temp = temp & f.Columns(i).Width * 0.8 & ";"
Next
Me.ComboBox1.ColumnCount = Ncol
Me.ComboBox1.ColumnWidths = temp
'-- entêtes TextBox
For i = 1 To Ncol
Set Lab = Me.Controls.Add("Forms.Label.1")
Lab.Caption = f.Cells(2, i)
Lab.Top = Me("textbox" & i + 1).Top - 17
Lab.Left = Me("textbox" & i + 1).Left

Next
End Sub

Private Sub comboBox1_Change()
If Me.ComboBox1 <> "" Then
If Me.ComboBox1.ListIndex = -1 Then
mots = Split(Trim(Me.ComboBox1), " ")
Tbl = choix
For i = LBound(mots) To UBound(mots)
Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
Next i
n = 0: Dim b()
For i = LBound(Tbl) To UBound(Tbl)
a = Split(Tbl(i), "*")
n = n + 1: ReDim Preserve b(1 To Ncol, 1 To n)
For k = 1 To Ncol
b(k, i + 1) = a(k - 1)
Next k
Next i
If n > 0 Then
ReDim Preserve b(1 To Ncol, 1 To n + 1)
Me.ComboBox1.List = Application.Transpose(b)
Me.ComboBox1.RemoveItem n
End If
Me.ComboBox1.DropDown
Else
For k = 0 To Ncol - 1
Me("textBox" & k + 2) = Me.ComboBox1.Column(k)
Next k
End If
End If
End Sub

ok merci bien pour la procédure ... j'avais raté une étape!

https://www.cjoint.com/c/JGCrqKkoHDj

j'ai bien examiné ton code.c'est parfait et exactement ce qu'il me faut mais je n'arrive ps à l'adapter. je souhaite conserver la recherche intuitive dans ma combobox et du coup je ne sais pas comment faire...

salut Le Pivert.merci pour tes recherches.
j'ai une erreur d'execution 9. en lançant le dblclick.est ce qu'il ne faudrait pas que je change la façon d'afficher mes liens hypertextes ?

Bon alors là c'est à n'y rien comprendre ... ca ne fonctionne pas chez moi !!!

étrange ... je regarde ca en vérifiant tout ! je te tiens au courant .
grand merci pour le coup de mains !!!

Et bien désolé ... rien n'y fait. je vais essayer sur une autre bécane au cas ou...

salut Le Pivert!
Bon ca ne fonctionne tjs pas...! j'avais aussi essayé de renommer les lien pour ne plus avoir de ' mais apparement rien n'y fait ! c'est vraiment un problème car je ne vois pas ce qu cloche !