Rechercher les Données sur une autre feuille

  • Initiateur de la discussion Initiateur de la discussion maval
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

maval

XLDnaute Barbatruc
Bonjour

J'ai un formulaire pour l'ouvrir je click sur une cellule de la colonne "B" de la feuille nommé "Liste" jusqu'ici tous va bien;
Après j'aimerai que textbox se remplissent avec les renseignements de la feui2 qui correspond au non?

Mon code
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    If Not Application.Intersect(Target, Columns(2), UsedRange) Is Nothing Then
        With UserForm1
            .TextBox2.Value = Target.Offset(0, 2).Text
            .TextBox1 = Target.Text
            .TextBox3 = Target.Offset(0, 4).Text
            .TextBox4 = Target.Offset(0, 6).Text
            .TextBox5 = Target.Offset(0, 8).Text
            .TextBox6 = Target.Offset(0, 10).Text
            .TextBox7 = Target.Offset(0, 12).Text
 
            
            .Show
        End With
    End If
End Sub
je vous remercie de votre aide

et vous souhaite une bonne soirée

Max
 

Pièces jointes

Dernière édition:
Re : Rechercher les Données sur une autre feuille

Bonsoir maval,

Un essai en cliquant sur une photo de chien (voir à ce sujet le nota bene). Pour l'image, je ne connais pas le contrôle WebBrowser donc je n'ai pas pu l'intégrer dans le formulaire.

Code dans le module de la feuille Feuil2:
VB:
Private Sub Worksheet_Activate()
  Definir_OnAction
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Definir_OnAction
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Definir_OnAction
End Sub

Sub Definir_OnAction()
Dim xshp As Shape
  For Each xshp In Worksheets("Feuil2").Shapes
    xshp.OnAction = "'" & "Aff_Form """ & xshp.TopLeftCell.Address & """" & "'"
  Next xshp
End Sub


Code dans le module1:
VB:
Sub Aff_Form(xadresse)
Dim sh As Worksheet, nomchien As String
Dim xrg As Range
  Set sh = ThisWorkbook.Sheets("Feuil2")
  nomchien = sh.Range(xadresse).Offset(, 1)
  Set xrg = sh.Range("c:c").Find(nomchien, , xlValues, xlWhole)
  If xrg Is Nothing Then Exit Sub
  With UserForm1
    .TextBox1 = nomchien
    .TextBox2 = xrg.Offset(, 2).Value
    .TextBox3 = xrg.Offset(, 4).Value
    .TextBox4 = xrg.Offset(, 6).Value
    .TextBox5 = xrg.Offset(, 8).Value
    .TextBox6 = xrg.Offset(, 10).Value
    .TextBox7 = xrg.Offset(, 12).Value
  End With
  UserForm1.Show
End Sub


nb: J'ai mal lu la question 🙁 => il fallait utiliser la liste de la feuil1 pour déclencher l'apparition du formulaire, cependant mon code comprend le remplissage du formulaire (cf code du module1)et ce code peut être adapté au votre...
En cas de difficultés, revenez les exposer dans ce fil.
 

Pièces jointes

Dernière édition:
Re : Rechercher les Données sur une autre feuille

Bonjour maval,

Pour afficher les images dans userform1:

Grace à un code de STEPHEN BULLEN, Office Automation Ltd 🙂 trouvé sur le web (Office Automation Ltd. - Stephen Bullen's Excel Page puis télécharger fichier : PastePicture.zip) et recopié tel quel 😱 dans le module "modPastePicture", j'ai pu copier les images de la feuille Feuil2 vers le userform.

Dans cette version, on obtient l'affichage du Userform par deux manipulations:
  1. soit sur la feuille Liste, double-cliquer sur une cellule contenant un nom de race de chien.
  2. soit sur la feuille Feuil2, cliquer sur une image représentant un chien de la race.

Pour quitter le userform, on peut appuyer sur la touche Escape.

Les codes se trouvent dans:

le module de code de la feuille Liste
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh As Worksheet, nomchien As String
Dim xrg As Range, xshp As Shape, i As Long
  
  Cancel = True
  nomchien = Target
  If Not Application.Intersect(Target, Columns(2)) Is Nothing Then
    If Len(nomchien) > 0 Then
      Set sh = ThisWorkbook.Sheets("Feuil2")
      Set xrg = sh.Range("c:c").Find(nomchien, , xlValues, xlWhole)
      If Not xrg Is Nothing Then Aff_Form xrg.Offset(, -1).Address
    End If
  End If
End Sub
Le module de code de la feuille Feuil2
VB:
Private Sub Worksheet_Activate()
  Definir_OnAction
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Definir_OnAction
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Definir_OnAction
End Sub
Le module de code de Userform1
VB:
Private Sub cbtFIN_Click()
  Unload UserForm1
End Sub

Private Sub UserForm_Terminate()
  Set Me.Image1.Picture = Nothing
End Sub
Le module modPastePicture (copie du code de STEPHEN BULLEN)
voir dans le fichier joint

Le module modAfficheUSF1
VB:
Sub Definir_OnAction()
Dim xshp As Shape
  For Each xshp In Worksheets("Feuil2").Shapes
    xshp.OnAction = "'" & "Aff_Form """ & xshp.TopLeftCell.Address & """" & "'"
  Next xshp
End Sub

Sub Aff_Form(xadresse)
Dim sh As Worksheet, nomchien As String
Dim xrg As Range, xshp As Shape, i As Long
  Set sh = ThisWorkbook.Sheets("Feuil2")
  nomchien = sh.Range(xadresse).Offset(, 1)
  Set xrg = sh.Range("c:c").Find(nomchien, , xlValues, xlWhole)
  If xrg Is Nothing Then Exit Sub
  With UserForm1
    .TextBox1 = nomchien
    .TextBox2 = xrg.Offset(, 2).Value
    .TextBox3 = xrg.Offset(, 4).Value
    .TextBox4 = xrg.Offset(, 6).Value
    .TextBox5 = xrg.Offset(, 8).Value
    .TextBox6 = xrg.Offset(, 10).Value
    .TextBox7 = xrg.Offset(, 12).Value
    '------------- image
    '
    For i = 1 To sh.Shapes.Count
      If sh.Shapes(i).TopLeftCell.Address = xadresse Then
         sh.Shapes(i).CopyPicture
         Exit For
      End If
    Next i
    Set .Image1.Picture = PastePicture(xlPicture)
  End With
  UserForm1.Show
End Sub

nb: Fichier Classeur_Photo v2.xlsm ==> préférer le v3: Lien supprimé du message #7
 
Dernière édition:
Re : Rechercher les Données sur une autre feuille

Bonjour à tous,

Je constate un décalage des informations sur les deux premières images.
La fiche du Briard n'est pas renseignée au clique sur l'image alors qu'elle est renseignée sur le double clique sur le Nom.

Joli travail.

A+ à tous
 
Dernière édition:
Re : Rechercher les Données sur une autre feuille

Bonjour à tous, à JCGL 🙂

[...] Je constate un décalage des informations sur les deux premières images.
La fiche du Briard n'est pas renseignée au clique sur l'image alors qu'elle est renseignée sur le double clique sur le Nom.[...]

Je n'arrive pas à reproduire ce phénomène et ça m'énerve un tout petit peu 😡

A tout hasard (et de toute manière, je pense que ça manquait), j'ai redéfini les OnAction des images à l'ouverture du fichier.

A part cela, le fichier v2 est identique au v3. J'ai aussi modifié chaque renseignement sur la feuille Feuil2 pour y rappeler la race de chien et le type de renseignement, et cela, uniquement à des fin de vérification à l'affichage du userform.
 

Pièces jointes

Re : Rechercher les Données sur une autre feuille

(re)Bonjour le forum, maval, JCGL,

[...] Plus de décalage... [...]

Je te remercie, JCGL, d'avoir testé la v3 et de m'annoncer une bonne nouvelle ! 🙂


Pour maval,

Le code que j'ai rajouté à la v3 par rapport à la v2 est situé dans le module de code de ThisWorkbook. Il permet de s'assurer que les images de la feuille Feuil2 pointent toutes vers la "bonne action" quand on clique dessus. Le code:
VB:
Private Sub Workbook_Open()
  Definir_OnAction
End Sub
 
Dernière édition:
Re : Rechercher les Données sur une autre feuille

Bonjour Si....

Je te remercie mais j'ai un message d'erreur

"Impossible de charger le objet car il n'est pas disponible sur cette machine"

Pourrais me dire se que je n'est pas?

Max
 
Re : Rechercher les Données sur une autre feuille

re

contrôle Si... tu disposes du "fameux" MSCOMCTL.OCX.
Je joins le bon fichier* avec une image explicative.

* mauvaises récupérations dans le précèdent mais c'est la méthode qui importe.
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
589
Retour