Positionnement dans un fichier

Question

Voilà mon problème. J'ai un fichier Excel A qui représente un arbre généalogique. Dans chacune des cellules de l'arbre il y a le nom d'un ancêtre. Dans un autre fichier Excel B il y a la liste de chaque ancêtre suivi de renseignements sur ce dernier (tout sur la même ligne). Je voudrais qu'en cliquant sur un ancêtre du fichier A, le fichier B s'ouvre et sélectionne la ligne de l'ancêtre en question. Merci d'avance si vous pouvez m'aider Cordialement...

U. Milité · Answer

Joins une version allégée de ton "arbre", ainsi que du fichier avec la liste, qu'on puisse visualiser, tester (le cas échéant) et proposer des pistes concrètes...

curulis57 · Answer

Bête question, me diras-tu mais pourquoi n'inclus-tu pas ton FichierB dans le FichierA? Tu aurais tout sous la main! A+...

Theze · Answer

Une piste à mettre dans le module de la feuille du fichier "Fichier_A.xlsx". Le résultat en ligne 1 à partir de A1. Comme curulis57 ( U. Milité ), je pense qu'il serait plus simple d'utiliser une autre feuille du classeur plutôt qu'un autre classeur mais c'est toi qui vois : Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Cls As Workbook Dim Plage As Range Dim Cel As Range If Target.Value = "" Then Exit Sub On Error Resume Next Set Cls = Workbooks("Fichier_B.xlsx") If Err.Number &lt;&gt; 0 Then Set Cls = Workbooks.Open(ThisWorkbook.Path &amp; "\" &amp; "Fichier_B.xlsx") On Error GoTo 0 With Cls.Worksheets("Feuil1"): Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With Set Cel = Plage.Find(Target.Value, , xlValues, xlWhole) If Not Cel Is Nothing Then End If With Cls.Worksheets("Feuil1"): Set Plage = .Range(.Cells(Cel.Row, 1), .Cells(Cel.Row, Columns.Count).End(xlToLeft)): End With With ThisWorkbook.Worksheets("Feuil1"): .Range(.Cells(1, 1), .Cells(1, Plage.Columns.Count)).Value = Plage.Value: End With End Sub...

curulis57 · Answer

Tu aurais même 1.000.000 d'ancêtres que ça ne poserait pas de problème.... Réunis tes deux fichiers et explique-nous ta fiche ! A+...

Theze · Answer

Re,

Voici le code modifié pour une seconde feuille nommée "Feuil2" servant de base de données :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range

    If Target.Value = "" Then Exit Sub

    Set Fe = Worksheets("Feuil2")

    With Fe: Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    Set Cel = Plage.Find(Target.Value, , xlValues, xlWhole)

    If Not Cel Is Nothing Then

    End If

    With Fe: Set Plage = .Range(.Cells(Cel.Row, 1), .Cells(Cel.Row, Columns.Count).End(xlToLeft)): End With

    With Worksheets("Feuil1"): .Range(.Cells(1, 1), .Cells(1, Plage.Columns.Count)).Value = Plage.Value: End With

End Sub

A noter que la méthode Find() est très rapide pour la recherche par rapport à une boucle

curulis57 · Answer

Salut Theze, petite précision : j'imagine que, dans ton arbre, les étiquettes comportent autre chose que le NOM ? Un ou deux ou... prénoms ? Important pour adapter le code de recherche... Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' Cancel = True If Target = "" Then Exit Sub ' With Worksheets("BDD") On Error Resume Next iRow = .Range("B:B").Find(what:=Target, lookat:=xlWhole).Row If iRow &lt;&gt; "" Then .Activate .Rows(iRow).Select Else MsgBox "Inconnu dans la BDD !", vbInformation, "BDD - Info" End If On Error GoTo 0 End With ' End Sub Pour le reste, pas de panique, hein! A+...

Theze · Answer

Désolé, j'avais mal lu la question (tu voulais la sélection du nom dans la base et non le rapatriement des valeurs) Une piste avec ton formulaire. Le fichier contient trois feuille, l'organigramme, la base de données et le formulaire. Un clic sur un nom de l'organigramme affiche le formulaire avec les valeurs. Un tableau de correspondance contient les adresse de cellules où doivent être inscrites les différentes valeurs. Les adresses dans le tableau doivent correspondre aux entêtes de la base de données afin de pouvoir boucler. Le code et le fichier : Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Fe As Worksheet Dim Plage As Range Dim Cel As Range Dim Tbl() Dim I As Integer If Target.Value = "" Then Exit Sub ReDim Tbl(1 To 8) '&lt;--- redimensionner par rapport au nombre de champs 'faire correspondre les adresses avec les entêtes ! Tbl(1) = "B3": Tbl(2) = "F3": Tbl(3) = "H1": Tbl(4) = "B11": Tbl(5) = "F11" 'Nom, Prénom, N°SOSA, Père, Mère Tbl(6) = "B5": Tbl(7) = "D5": Tbl(8) = "G5" 'Date naissance, Lieu naissance, Pays naissance 'etc... Set Fe = Worksheets("BDD") With Fe: Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With Set Cel = Plage.Find(Target.Value, , xlValues, xlWhole) If Not Cel Is Nothing Then With Fe: Set Plage = .Range(.Cells(Cel.Row, 1), .Cells(Cel.Row, Columns.Count).End(xlToLeft)): End With For I = 1 To Plage.Count Worksheets("Formulaire").Range(Tbl(I)).Value = Plage(I).Value Next I End If Worksheets("Formulaire").Select End Sub...

curulis57 · Answer

Voilà ton fichier à l'heure actuelle. double-clic sur une cellule blanche la prépare pour un encodage d'étiquette (fond jaune + bordure) ; double-clic sur une cellule jaune mais vide = annulation de la préparation à l'encodage ; double-clic sur une cellule jaune complétée = recherche de l'ancêtre dans la 'BDD' : * si présent, la ligne s'allume en 'BDD' et affichage ; * parallèlement, la fiche se remplit via formules. Elle ne sert donc pas à encoder l'arbre généalogique! * message si absent de 'BDD'. - pour l'encodage de tes étiquettes, le plus facile est : * d'abord de compléter la 'BDD' ; * de taper simplement le code SOSA, la macro faisant le reste! A toi de guider la suite de la manoeuvre! A+...