Code vba lien hypertext depuis un textbox vers un onglet de classeur
Scanadoo646464
Messages postés
16
Date d'inscription
Statut
Membre
Dernière intervention
-
Scanadoo646464 Messages postés 16 Date d'inscription Statut Membre Dernière intervention -
Scanadoo646464 Messages postés 16 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Je cherche une piste pour activer par double click un lien hypertext dans un textbox vers un onglet de classeur. Si quelqu'un a des idées.
Merci.
Je cherche une piste pour activer par double click un lien hypertext dans un textbox vers un onglet de classeur. Si quelqu'un a des idées.
Merci.
Configuration: Android / Chrome 84.0.4147.89
A voir également:
- Code vba lien hypertext depuis un textbox vers un onglet de classeur
- Code ascii - Guide
- Créer un lien pour partager des photos - Guide
- Comment déverrouiller un téléphone quand on a oublié le code - Guide
- Lien url - Guide
- Rouvrir un onglet fermé - Guide
9 réponses
Bonjour,
un exemple:
mettre le lien dans la cellule A1 de la feuille sur laquelle s'ouvrira l'UserForm
A adapter
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
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
le lien hypertexte fonctionne pour google map mais pas pour mon classeur.
Ce n'est pas la même procédure pour les liens internes au classeur.
voir cette discussion avec un classeur à télécharger
https://codes-sources.commentcamarche.net/forum/affich-10101612-lancement-d-un-lien-hypertexte-avec-une-macro?page=2#45
@+
Ce n'est pas la même procédure pour les liens internes au classeur.
voir cette discussion avec un classeur à télécharger
https://codes-sources.commentcamarche.net/forum/affich-10101612-lancement-d-un-lien-hypertexte-avec-une-macro?page=2#45
@+
bon je viens de tout essayer... a ne fonctionne pas! mais sans mon fichier ca sera dure de trouver une solution...je n'arrive pas à charger mon fichier pour le mettre en lien sur mes réponses. Avec une cap de ma bd cela devrait etre plus clair...
Et donc quand le lien d'une cel de la col 7 s'affiche dans ma textbox7 je voudrais activer ce lien avec dblclick pour accéder a l'onglet correspondant.
Et donc quand le lien d'une cel de la col 7 s'affiche dans ma textbox7 je voudrais activer ce lien avec dblclick pour accéder a l'onglet correspondant.
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...
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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 ?
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 ?
Cela fonctionne chez moi. Cela ne vient pas des liens, on ne s'en sert pas!
Il n'y a que la TextBox 7 à modifier
j'ai une erreur d'execution 9
pour corriger mets ceci:
@+
Il n'y a que la TextBox 7 à modifier
j'ai une erreur d'execution 9
pour corriger mets ceci:
Private Sub TextBox7_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim feuille As String If TextBox7.Text = "" Then Exit Sub feuille = Split(TextBox7.Text, "'")(0) Sheets(feuille).Activate End Sub
@+
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 !!!
grand merci pour le coup de mains !!!
