Liens hypertexte dans des listes déroulantes
#1
Débutant XLPages

Inscription: 16/01/2017
De Vulbens France

Messages: 11

Système d'exploitation:
PC
Version Excel utilisée:
2007,2016
Posté le : 16-01 13h37

Bonjour à tous,

 

Petit nouveau dans ce forum, je vous demande d'avance de m'excuser si mes procédures d'utilisation du forum ne sont pas encore rodées.

 

J'ai un classeur Excel (.xlsm) qui présente sur une page des listes déroulantes contenant des liens hypertexte.

J'ai récupéré le code VBA ci-dessous qui fonctionne très bien sur la première liste (Merci à Didier Fourgeot).

Dans les autres listes, les liens sont visibles mais ne fonctionnent pas

'ABATS
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Cel As Range
Dim ValidOk As Boolean
    On Error Resume Next
    ValidOk = ActiveCell.Validation.Formula1 = "=ListAbats"
    On Error GoTo 0
    If Len(ActiveCell.Value) = 0 Or Not ValidOk Then Exit Sub
    Set Cel = [ListAbats].Find(what:=ActiveCell.Value, LookIn:=xlValues)
    Sh.Hyperlinks.Add Anchor:=ActiveCell, Address:=Cel.Hyperlinks(1).Address
    ActiveCell.Hyperlinks(1).SubAddress = Cel.Hyperlinks(1).SubAddress
End Sub

Ce code est répété plusieurs fois en modifiant le nom (SheetChange) et le nom de la plage de cellules (ListAbats).

Merci d'avance de votre aide

Bien cordialement


Pierre
Hors Ligne
Rapport   Haut 

Re: Liens hypertexte dans des listes déroulantes
#2
Aspirant XLPages

Inscription: 15/07/2016
De Allier

Messages: 26

Système d'exploitation:
PC
Version Excel utilisée:
2007, 2010
Posté le : 16-01 16h49

Bonjour pierrev, toutes et tous,

 

Je ne sais pas je pourrai t'aider, mais si ton fichier n'a pas de données confidentielles (sinon mettre des données bidons et garder la structure du fichier), le mieux serai de le joindre à ton message.

 

Cordialement.

Hors Ligne
Rapport   Haut 

Re: Liens hypertexte dans des listes déroulantes
#3
Débutant XLPages

Inscription: 16/01/2017
De Vulbens France

Messages: 11

Système d'exploitation:
PC
Version Excel utilisée:
2007,2016
Posté le : 16-01 21h34

Bonsoir Lcntrcld et bonsoir à tous,

Merci de m'avoir répondu.

Pour le fichier, j'avais penser le joindre, mais il fait plus de 80 kb.

Peut-être sur ton mail !

Je donne le mien si cela peut-être utile.

pierrev@windowslive.com

Encore merci de ton aide.

Bien cordialement

Pierrev


Pierre
Hors Ligne
Rapport   Haut 

Re: Liens hypertexte dans des listes déroulantes
#4
Accro XLPages

Inscription: 17/08/2007
De Québec, Canada

Messages: 180

Système d'exploitation:
PC
Version Excel utilisée:
Excel 2003, 2007 (FR) & MsProject 2003
Posté le : 16-01 23h43

Salut le Forum

 

Oups, désolé je vois que LCNTRCLD t'a déjà répondu.

 

Erreur 

Mytå


Merci, de donner un retour à votre question, nous ne sommes pas des robots. [GMT - 5]
Le travail d'équipe est essentiel. En cas d'erreur, ça permet d'accuser quelqu'un d'autre.
Hors Ligne
Rapport   Haut 

Re: Liens hypertexte dans des listes déroulantes
#5
Aspirant XLPages

Inscription: 15/07/2016
De Allier

Messages: 26

Système d'exploitation:
PC
Version Excel utilisée:
2007, 2010
Posté le : 17-01 02h52

Bonjour pierrev,

Salut Mytå,

 

Je suis désolé Pierre, mais je ne donne plus mon adresse mail, car trop de déception et retour sur expérience.

 

Une autre solution essai de passer par http://www.cjoint.com/ tu clique sur ce lien, tu suis les instructions et ensuite tu colle le lien avec ton message.

 

Si tu arrive à faire ça, alors Mytå dont je connais sa grande compétence en VBA, pourra t'aider.

 

Cordialement.

Hors Ligne
Rapport   Haut 

Re: Liens hypertexte dans des listes déroulantes
#6
Débutant XLPages

Inscription: 16/01/2017
De Vulbens France

Messages: 11

Système d'exploitation:
PC
Version Excel utilisée:
2007,2016
Posté le : 17-01 07h04

Bonjour Lcntrcld et bonjour à Mytå,

 

Merci à tous les deux de votre gentillesse à me dépanner.

 

Le fichier se trouve à l'adresse http://www.cjoint.com/c/GArf0TE8hpq.

Il ne comporte que des données publiques qui concernent la nutrition.

 

Intéressant cette façon de partager un fichier !

Merci encore à vous 2

 

Hors Ligne
Rapport   Haut 

Re: Liens hypertexte dans des listes déroulantes
#7
Aspirant XLPages

Inscription: 15/07/2016
De Allier

Messages: 26

Système d'exploitation:
PC
Version Excel utilisée:
2007, 2010
Posté le : 17-01 07h53

Re Pierre,

 

Je suis désolé, mais je n'arrive pas a télécharger ton fichier, sans doute dû à ma version d'Excel (2007 & 2010)

Mytå le pourra peut-être.

 

Cdlt.

Hors Ligne
Rapport   Haut 

Re: Liens hypertexte dans des listes déroulantes
#8
Débutant XLPages

Inscription: 16/01/2017
De Vulbens France

Messages: 11

Système d'exploitation:
PC
Version Excel utilisée:
2007,2016
Posté le : 17-01 09h56

Rebonjour Lcntrcld,

 

Bizarre, le clic sur le lien de téléchargement:

  • Il me propose d'ouvrir le fichier et boom! impossible d'ouvrir le fichier
  • Après un nouveau clic sur le lien, je choisis d'enregistrer le fichier sur le bureau et un petit double clic après, il est ouvert.

 

Les mystères de l'informatique sans doute !

 

Bien cordialement

 

Hors Ligne
Rapport   Haut 

Re: Liens hypertexte dans des listes déroulantes
#9
Débutant XLPages

Inscription: 16/01/2017
De Vulbens France

Messages: 11

Système d'exploitation:
PC
Version Excel utilisée:
2007,2016
Posté le : 18-01 07h48

Bonjour à tous,

J'ai trouvé un code qui fonctionne avec des liens hypertexte qui renvoient sur des pages Internet ou vers des fichiers.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$11" Then
    ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=Target.Value, TextToDisplay:=Target.Value
  End If
End Sub

Malheureusement, ce code ne permet pas de sélectionner la cellule d'une autre feuille.

Je joins le fichier comme exemple.

Peut-être une idée de solution!

Bien cordialement à tous

 

Pièce jointe:
xls Test liens hypertexte.xls   [ Taille: 47.50 Ko - Téléchargements: 16 ]
Hors Ligne
Rapport   Haut 

Re: Liens hypertexte dans des listes déroulantes
#10
Accro XLPages

Inscription: 09/01/2008
De Montréal, Québec

Messages: 455

Système d'exploitation:
PC
Version Excel utilisée:
97 à 2013
Posté le : 18-01 16h21

Bonjour pierrev, Lcntrcld, Mytå,

 

Le code de Didier a été copié dans diverses procédures de ThisWorkbook, malheureusement ces procédures, au nombre de 32(!!) sont inopérantes et ne sont jamais déclenchées...

  • Private Sub Workbook_SheetChange38
  • Private Sub Workbook_SheetChange15
  • ...
  • Private Sub Workbook_SheetChange24_3

Seule la procédure Private Sub Workbook_SheetChange est active. Mais celle-ci portait à l'origine la contrainte : ActiveCell.Validation.Formula1 = "=ListAbats". Voilà pourquoi seule cette liste est prise en compte.

 

J'ai modifié la procédure pour prendre en compte toutes les listes et pas seulement ListAbats.

 

'-------------------------------------------------------------------------
Option Explicit

' Procédure : Workbook_SheetChange
' Auteur    : Guy Courville
' Date      : 2017-01-18
'
' Référence : Didier FOURGEOT (monCherAmi!)
'             2006-03-06
'
' Détails   : Modification de la procédure pour tenir compte de listes multiples.
'
'-------------------------------------------------------------------------
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

  Dim ValidOk As Boolean
  Dim ChainePlageCible As String ' Porte la chaîne de caractères du nom de la plage ciblée.
  Dim PlageCible As Range        ' Porte la plage ciblée.
  Dim CelluleCible As Range      ' Porte la cellule ciblée.
  
  On Error Resume Next
  ChainePlageCible = Target.Validation.Formula1 ' Chaîne sous la forme "=Toto"
  ChainePlageCible = Right(ChainePlageCible, Len(ChainePlageCible) - 1) ' Chaîne précédente privé de "=" : "Toto"
  
  Set PlageCible = Range(ChainePlageCible) ' La plage ciblée est prise en référence.
  
  ValidOk = (Err.Number = 0) ' Est valide si l'erreur est à zéro.
  
  On Error GoTo 0
  If Len(Target) = 0 Or Not ValidOk Then Exit Sub
  
  Set CelluleCible = PlageCible.Find(what:=Target.Value, LookIn:=xlValues) ' La cellule ciblée est prise en référence.
  
  On Error Resume Next
  
  Sh.Hyperlinks.Add Anchor:=Target, Address:=CelluleCible.Hyperlinks(1).Address ' Le lien de CelluleCible est ajouté
  If Err.Number > 0 Then
    MsgBox "La CelluleCible ne porte aucun lien", vbInformation, "Oups, il manque quelque chose!"
    Exit Sub
  End If
  
  On Error GoTo 0
  Target.Hyperlinks(1).SubAddress = CelluleCible.Hyperlinks(1).SubAddress
  
End Sub

Il faudra sûrement peaufiner mais je t'invite à tester la chose et à nous tenir au courant des résultats.

À noter la directive Option Explicit à ajouter à toutes les en-têtes de module. Plus là-dessus sous peu.

 

Cordialement,

 

Guy


Hors Ligne
Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   2 Utilisateur(s) anonymes