Code vba lien hypertext depuis un textbox vers un onglet de classeur
Fermé
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
-
27 juil. 2020 à 19:52
Scanadoo646464 Messages postés 16 Date d'inscription lundi 27 juillet 2020 Statut Membre Dernière intervention 30 juillet 2020 - 30 juil. 2020 à 14:45
Scanadoo646464 Messages postés 16 Date d'inscription lundi 27 juillet 2020 Statut Membre Dernière intervention 30 juillet 2020 - 30 juil. 2020 à 14:45
A voir également:
- Code vba lien hypertext depuis un textbox vers un onglet de classeur
- Verifier un lien - Guide
- Créer un lien pour partager des photos - Guide
- Lien url - Guide
- Rouvrir un onglet fermé - Guide
- Code asci - Guide
9 réponses
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
28 juil. 2020 à 08:09
28 juil. 2020 à 08:09
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
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
28 juil. 2020 à 09:49
28 juil. 2020 à 09:49
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
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
28 juil. 2020 à 09:59
28 juil. 2020 à 09:59
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
>
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
28 juil. 2020 à 11:42
28 juil. 2020 à 11:42
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
@+
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
>
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
28 juil. 2020 à 12:57
28 juil. 2020 à 12:57
Merci à toi et pour le temps consacré aux béotiens ! je vais essayer de bien comprendre avant de revenir te déranger!
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
>
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
28 juil. 2020 à 14:01
28 juil. 2020 à 14:01
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.
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
>
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
28 juil. 2020 à 14:28
28 juil. 2020 à 14:28
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
28 juil. 2020 à 19:18
28 juil. 2020 à 19:18
ok merci bien pour la procédure ... j'avais raté une étape!
https://www.cjoint.com/c/JGCrqKkoHDj
https://www.cjoint.com/c/JGCrqKkoHDj
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
28 juil. 2020 à 22:06
28 juil. 2020 à 22:06
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...
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
29 juil. 2020 à 10:39
29 juil. 2020 à 10:39
Tes liens hypertexte servent uniquement à activer les onglets. Il suffit donc de mettre ceci:
@+ Le Pivert
Private Sub TextBox7_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim feuille As String feuille = Split(TextBox7.Text, "'")(0) Sheets(feuille).Activate End Sub
@+ Le Pivert
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
29 juil. 2020 à 11:28
29 juil. 2020 à 11:28
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 ?
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
Modifié le 29 juil. 2020 à 11:36
Modifié le 29 juil. 2020 à 11:36
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
@+
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
>
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
29 juil. 2020 à 11:50
29 juil. 2020 à 11:50
Bon toujours erreur 9. j'ai tout vérifier , je vois pas ...
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
>
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
29 juil. 2020 à 11:54
29 juil. 2020 à 11:54
Voici le classeur qui fonctionne chez moi!
https://www.cjoint.com/c/JGDj1E6ErOQ
https://www.cjoint.com/c/JGDj1E6ErOQ
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
29 juil. 2020 à 11:58
29 juil. 2020 à 11:58
Bon alors là c'est à n'y rien comprendre ... ca ne fonctionne pas chez moi !!!
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
29 juil. 2020 à 12:01
29 juil. 2020 à 12:01
y aurait il un rapport avec la version d'excel utilisée ...?
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
>
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
29 juil. 2020 à 12:08
29 juil. 2020 à 12:08
C'est un classeur avec l'extension xlsm prenant en charge les macro depuis Office 2007
Je ne comprends pas!
J'ai moi même Office 2007 qui fonctionne très bien
Je ne comprends pas!
J'ai moi même Office 2007 qui fonctionne très bien
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
29 juil. 2020 à 12:10
29 juil. 2020 à 12:10
é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 !!!
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
29 juil. 2020 à 13:34
29 juil. 2020 à 13:34
Et bien désolé ... rien n'y fait. je vais essayer sur une autre bécane au cas ou...
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
29 juil. 2020 à 14:17
29 juil. 2020 à 14:17
toujours le meme message d'erreur exec 9... j'ai jusqu'au 17 août pour trouver une solution, je vais chercher de mon côté.
si tu trouve d'ici là je suis preneur, sinon merci encore pour le coup de main.
si tu trouve d'ici là je suis preneur, sinon merci encore pour le coup de main.
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
728
>
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
30 juil. 2020 à 10:51
30 juil. 2020 à 10:51
J'ai modifié les liens hypertexte vers les onglets ainsi que les Retours vers la feuille Recherche:
https://www.cjoint.com/c/JGEiXqSfxyQ
Vois si cela fonctionne
@+ Le Pivert
https://www.cjoint.com/c/JGEiXqSfxyQ
Vois si cela fonctionne
@+ Le Pivert
Scanadoo646464
Messages postés
16
Date d'inscription
lundi 27 juillet 2020
Statut
Membre
Dernière intervention
30 juillet 2020
30 juil. 2020 à 14:45
30 juil. 2020 à 14:45
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 !
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 !
