Lien hypertexte sur liste déroulante multiple

Bonsoir a tous et a toutes

Je viens vers vous pour voir si quelqu’un peut m’aidè ou m’aiguillais dans mon problème

Voila, dans le fichier joint il y a un dossier avec plusieurs liste déroulante qui arrive a la fin sur

( numéro local) donc voila mon soucie, je vaudrais savoirs si cet possible de pouvoir cliquet dans cette case

les liens hypertexte qui sont déjà sur la feuille (base de donnée) en colonne BE pour la première ville , en BI pour seconde ville, et en BM pour la troisième .

Si quelqu"un peut m'aider je suis preneur de tout et vous en remercie par avance

Si vous avez besoin d'autre renseignement n’hésiter pas a me demander .

Cordialement

Bonjour

Ta fonction personnalisée Find_Range te donne l'adresse de la cellule correspondante dans la Base de données.

Pourquoi ne pas complèter ton code en copiant cette cellule et en la collant en D21? Le lien serait ainsi copié.

Au passage, cette fonction m'intéresse. Pourrais-tu nous fournir le code?

Cordialement

Bonsoir,

Ci-dessous le code générique de la fonction Find_Range (voir exemple dans fichier).

Je recherche l'auteur (!?)

Option Explicit
Enum eLookin
    xl_Formulas = -4123
    xl_Comments = -4144
    xl_Values = -4163
End Enum

Enum eLookat
    xl_Part = 2
    xl_Whole = 1
End Enum
Function Find_Range(Find_Item As Variant, _
    Search_Range As Range, _
    Optional LookIn As eLookin, _
    Optional LookAt As eLookat, _
    Optional MatchCase As Boolean) As Range

    Dim c As Range, FirstAddress As String '<<

    If IsMissing(LookIn) Then LookIn = xlValues 'xlFormulas
    If IsMissing(LookAt) Then LookAt = xlPart 'xlWhole
    If IsMissing(MatchCase) Then MatchCase = False

    With Search_Range
        Set c = .Find(What:=Find_Item, LookIn:=LookIn, _
          LookAt:=LookAt, SearchOrder:=xlByRows, _
               SearchDirection:=xlNext, MatchCase:=MatchCase, _
                    SearchFormat:=False)

        If Not c Is Nothing Then
            Set Find_Range = c
            FirstAddress = c.Address
            Do
                Set Find_Range = Union(Find_Range, c)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With

End Function

Bonjour

Jean-Eric, merci pour ton exemple mais ce que je demandais est le code de la fonction personnalisée permettant l'utilisation comme dans le fichier de notre ami.

Je pourrais cracker le mdp de l'éditeur, mais par principe, j'aime mieux avoir l'autorisation de l'auteur.

Quoi qu'il en soit, merci de t'être intéréssé à ma demande.

Cordialement

Re,

Bonjour Amadéus,

La fonction personnalisée utilisée par l'éditeur est assurément (à 90%) celle que je t'ai communiqué, ou une variante.

De plus, je ne pense pas que la fonction utilisée par l'éditeur retourne le bon résultat.

Sinon, je n'ai pas cracké le MDP. Et mon fichier joint a été crée en Sept. 2012.

Cordialement.

Bonjour Jean-Eric

De plus, je ne pense pas que la fonction utilisée par l'éditeur retourne le bon résultat.

Sinon, je n'ai pas cracké le MDP. Et mon fichier joint a été crée en Sept. 2012

Pour ta seconde remarque, je n'en doute pas un seul instant.

Pour la première, tu as parfaitement raison, je n'avais pas contrôlé le résultat. La formule de notre ami renvoi un résultat faux.

Ci joint, un fichier sans macro, avec juste 2 formules pour obtenir le bon résultat.

C'est pour remplacer la formule matricielle en H13 que j'avais demandé le code de cette fonction personnalisée, code devenu inutile puisque la formule est erronée.

Cordialement

Bonsoir a tous et a toutes

Tout d'abord excusé moi j'ai oublier d'enlevé le MDP sur le classeur le voici sans ( mais bon il n'y a rien dedans pas de VBA )

Pour répondre d’abord a Amadéus voici en fichier joint d'ou je suis parti pour faire mon classeur

cet un classeur déjà fait que j'ai télécharger sur le forum et que j'ai adapter tant bien que mal au mien

ensuite pour répondre a Jean-Eric désolé de ne pouvoirs t'aider pour ta recherche de l'auteur je ne suis pas assez caler dans

le code et la VBA

Merci de votre aide pour mon problème mais en fait j'ai du mal m exprimer je voudrais arrivé a avoir le lien hypertexte (qui ouvre un dossier) qui ce trouve

et qui est déjà crée sur la feuille (Base de Donnée) en colonne BE BI BM ...le retrouvé dans la feuille (Référence Logement) en D21 et pouvoir le cliquet .

Merci encore pour votre intérêt a mon problème

Cordialement

Re bonsoir

je viens de faire a peut prés ce que je voulais mes je ne comprend pas le lien hypertexte que j'ai en C2

sur la feuille (feuille des liste de validation) ne pointe pas sur le même lien (Dossier) que sur la feuille ( liste ) en B3 ????

Si quelqu'un a une solution je suis preneur

Cordialement

Bonjour

Je ne maitrise surement pas assez pour faire mieux. En attendant:

Tu fais tes sélections, puis tu cliques sur le Bouton

Cordialement

Bonsoir

Une idée en passant

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range

    If Not Application.Intersect(Target, Range("C2")) Is Nothing Then
      Set Cel = Sheets("liste").Cells.Find(what:=Target, LookIn:=xlValues, lookat:=xlWhole)
        If Not Cel Is Nothing Then
          Application.EnableEvents = False
          Cel.Copy Target
          Application.EnableEvents = True
        End If
    End If
End Sub

Bonjour

La partition d'un chef...

Cordialement

Bonsoir a tous les deux et a tous bien sur

Je vais essayer vos solutions, bon là un peut tard pour moi donc je vous tien au courant

Merci encore

Amadéus a écrit :

Bonjour

Ta fonction personnalisée Find_Range te donne l'adresse de la cellule correspondante dans la Base de données.

Pourquoi ne pas complèter ton code en copiant cette cellule et en la collant en D21? Le lien serait ainsi copié.

Au passage, cette fonction m'intéresse. Pourrais-tu nous fournir le code?

Cordialement

Bonsoir a tous et a toutes

Aprés avoir tourner dans tout les sens mon problème, je reviens vers vous, car, même en cherchent sur le forum

je ne trouve pas de solution. Par contre je voudrais d'autre renseignement de la par de Amadéus, car, si je comprend bien si je complète

(la fonction Find_range) de ma cellule D21, je pourrais avoir mon lien hypertexte copié donc voila la question, comment faire ?Amadéus peut tu m'aider, pour complétè la fonction .

Par avance merci

Cordialement

Bonjour

Banzai64 t'as donné un code qui fonctionne parfaitement

Cordialement

bonsoir

Oui je l'ai essayé le code de banzai64 et je le remercie au passage

mes le soucie est que je suis obliger de double cliquer dans la cellule (D21) pour avoir le lien hypertexte et du coup ça m efface

la formule =SI.................et de plus je ne que plus refaire une autre recherche .Donc je penser qu'avec ton complément de code sur =SI............pour faire un copier coller du lien en D21 ça aurais pu marcher .

je te met le classeur en fichier joint pour voir ce que ça a donné avec le code de Banzai64

Cordialement

Bonsoir

Su le même principe que je j'ai proposé

Tu supprimes la fonction et tu remplaces la macro actuelle par celle-ci

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range

    If Not Application.Intersect(Target, Range("D16")) Is Nothing Then
      Set Cel = Sheets("Base de données").Cells.Find(what:=Target, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Cel Is Nothing Then
          Cel.Offset(0, 1).Copy Range("D21")
        End If
    End If
End Sub

Bonsoir a tous et a toutes

je tien a remercie tout ce qui oeuvre sur ce forum pour ce que vous faire pour des novices comme moi et je tien particulièrement a remercie Banzai64 ça macro fonctionne super bien cet exactement ce que je rechercher, youpi !!!! Je met le classeur en fichier joint ca peut servir a quelqu'un

Encore merci je clôture

A+