Recherche intuitive de Boisgontier Jacques

**graphikris** · 27/12/2016, 16h11

Bonjour,
J'ai essayé d'adapter la macro de Mr Boigontier Jacques mais j'éprouve pas mal de difficultés.

Nom : Image1.png
Affichages : 2070
Taille : 45,4 Ko

Ma feuille se nomme "Suivi Referentiel documentaire"
La recherche se fait à partir de la colonne E (TitreDocument) puis par type de document (colonne D).
A partir de ces deux recherches, le reste doit apparaître.

J'ai joint le fichier de Mr Boisgontier ainsi que le mien

Voici mon code qui ne fonctionne pas : bloque à la ligne 23

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Compare Text
Dim f, ligneEnreg, choix1()
Private Sub UserForm_Initialize()
  Set f = Sheets("Suivi Referentiel documentaire")
  choix1 = Application.Transpose(f.Range("E2:E" & f.[E65000].End(xlUp).Row).Value)
  Me.ChoixTitre.List = SansDoublons(choix1)
  ligneEnreg = f.[E65000].End(xlUp).Row + 1
  Me.ChoixTitre.SetFocus
End Sub
Private Sub ChoixTitre_Change()
  If Me.ChoixTitre.ListIndex = -1 And IsError(Application.Match(Me.ChoixTitre, choix1, 0)) Then
   Me.ChoixTitre.List = Filter(SansDoublons(choix1), Me.ChoixTitre.Text, True, vbTextCompare)
   Me.ChoixTitre.DropDown
  Else
    ChoixTitre_click
  End If
End Sub
Private Sub ChoixTitre_click()
  'For k = 1 To 4
  '  Me("Textbox" & k) = ""
  ' Next k
  a = f.Range("E2:D" & f.[D65000].End(xlUp).Row).Value
  Dim b(): ReDim b(1 To UBound(a))
  j = 0
  For i = 1 To UBound(a)
     If a(i, 1) = Me.ChoixTitre Then j = j + 1: b(j) = a(i, 2)
  Next i
  ReDim Preserve b(1 To j)
  Me.ChoixType.List = b
  Me.ChoixType.SetFocus
  If Val(Application.Version) > 10 Then SendKeys "{f4}"
End Sub
Private Sub ChoixType_click()
 For i = 2 To f.[D65000].End(xlUp).Row
  If f.Cells(i, "a") = Me.ChoixTitre And f.Cells(i, "b") = Me.ChoixType Then
    ligneEnreg = i
    For Each c In Me.Frame_Civilite.Controls
     If f.Cells(ligneEnreg, "c") = c.Caption Then c.Value = True
    Next c
    Me.Controls("TextBox1") = f.Cells(ligneEnreg, 1)
    Me.Controls("TextBox2") = f.Cells(ligneEnreg, 2)
    For k = 3 To 6
        Me.Controls("TextBox" & k) = f.Cells(ligneEnreg, k + 1)
      Next k
    End If
  Next i
End Sub
 
Function SansDoublons(a())
   Set d = CreateObject("Scripting.Dictionary")
   For Each c In a
      d(c) = ""
   Next c
   b = d.keys
   SansDoublons = b
End Function

Y a t'il une âme charitable pour m'aider ?

Cordialement

**joe.levrai** · 27/12/2016, 16h19

Bonjour,

a est un tableau de dimension 2 sur ta ligne 22
donc tu dois préciser la dimension dans tes appels Lbound() et Ubound()

la méthode de Jacques Boisgontier est basée sur un tableau unidimensionnel où la dimension n'est pas à gérer, puisqu'il n'y en a qu'une seule

**graphikris** · 27/12/2016, 17h31

Bonjour Joe,

Je ne comprend pas trop !

Est ce parce que mes données sont dans un tableau et non pas mises comme Boisgontier J ?

Question Vba, je ne suis pas au high level plutôt low

Peux tu m'aider ?

Merci

**Philippe Tulliez** · 27/12/2016, 18h43

Bonjour ,
Comme l'a clairement expliqué Joe, en ligne 22 du code que tu publies, tu génères un tableau à deux dimensions or en ligne 23, tu essayes de redimensionner la variable tableau à une dimension et cela ne peut pas fonctionner.
A lire Utiliser les variables tableaux en VBA Excel et Conceptualisation des variables tableau en VBA et Application à l'optimisation du code sous Excel et tout particulièrement le chapitre VIII-B. Alimentation d'une plage via une variable tableau

**joe.levrai** · 27/12/2016, 19h36

cette ligne de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

a = f.Range("E2:D" & f.[D65000].End(xlUp).Row).Value

prend une plage de deux colonnes pour la mettre dans un tableau "a"
on a donc deux dimensions : les lignes et les colonnes
et à la manière de l'utilisation d'un Cells(x,y) pour désigner une cellule de la feuille, on va faire a(x,y) pour naviguer dans le tableau
le nombre de lignes sera défini par Ubound(a,1) (indice maximum de la dimension 1) et le nombre de colonnes par Ubound(a,2) (indice maximum de la dimension 2)

Ps : quand on transfère des cellules vers un tableau, même si il n'y a qu'une ligne ou une colonne, le tableau sera toujours en 2D et en Base 1
il suffit de transposer le tableau (une fois pour 1 colonne et 2 fois pour une ligne) et on la ramène à une seule dimension

Ceci est encore mieux expliqué que ce modeste message dans les liens qu'a astucieusement fourni Philippe

**boisgontierjacques** · 27/12/2016, 20h17

Bonsoir,

Ne pas utiliser de cellules fusionnées!
Il y a au moins un pb de fond: la recherche en cascade ne peut pas fonctionner sur les colonnes E et D (pour fiches de progres , il y a 2 type formulaire)

Boisgontier

**graphikris** · 28/12/2016, 09h27

Envoyé par boisgontierjacques

Bonsoir,

Ne pas utiliser de cellules fusionnées!
Il y a au moins un pb de fond: la recherche en cascade ne peut pas fonctionner sur les colonnes E et D (pour fiches de progres , il y a 2 type formulaire)

Boisgontier

Bonjour,
Je tiens a vous remercier pour votre reponse ainsi que le fichier joint.
Bonnes fetes de fin d'années.

Envoyé par Philippe Tulliez

Bonjour ,
Comme l'a clairement expliqué Joe, en ligne 22 du code que tu publies, tu génères un tableau à deux dimensions or en ligne 23, tu essayes de redimensionner la variable tableau à une dimension et cela ne peut pas fonctionner.
A lire Utiliser les variables tableaux en VBA Excel et Conceptualisation des variables tableau en VBA et Application à l'optimisation du code sous Excel et tout particulièrement le chapitre VIII-B. Alimentation d'une plage via une variable tableau

Bonjour Philippe,
Merci à vous

**boisgontierjacques** · 28/12/2016, 10h34

Bonjour,

>

Cependant j'aurais voulu savoir comment faire pour que le reste des renseignements qui figure dans le tableau apparaisse également dans le UserForm ?

Le pb de fond subsiste

Boisgontier

**graphikris** · 29/12/2016, 08h58

Bonjour et un grand merci pour votre aide.
Concernant le pb du doc en double, cela reste passager car dès que le doc en "Evolution" sera validé, il sera remplacé par celui "A jour".

Cordialement

Juste une question pour le fun
Quel code mettre pour :
1 - Faire une nouvelle recherche donc réinitialiser les zones
2 - Un bouton pour imprimer le userform
3 - un bouton pour quitter le userform

Merci à vous

**graphikris** · 29/12/2016, 10h12

Bjr,
J'ai un petit souci avec la liste déroulante. Les espaces au niveau des paranthéses ou les apostrophes ne correspondent pas à la syntaxe de la liste réelle.
comment y remédier ?
Comment supprimer la casse dans la recherche car si j'ai en réalité : CAD002
et que je saisi CAD 002, je ne trouverais pas mon document.

Sinon petit bug dans la macro : A chaque fois que je l'utilise, le pavé numérique se désactive.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Option Compare Text
Dim f, ligneEnreg, choix1()
Private Sub UserForm_Initialize()
  Set f = Sheets("Suivi Referentiel documentaire")
  choix1 = Application.Transpose(f.Range("E2:E" & f.[E65000].End(xlUp).Row).Value)
  Me.ChoixTitre.List = SansDoublons(choix1)
  ligneEnreg = f.[E65000].End(xlUp).Row + 1
  Me.ChoixTitre.SetFocus
End Sub
Private Sub ChoixTitre_Change()
  If Me.ChoixTitre.ListIndex = -1 And IsError(Application.Match(Me.ChoixTitre, choix1, 0)) Then
   Me.ChoixTitre.List = Filter(SansDoublons(choix1), Me.ChoixTitre.Text, True, vbTextCompare)
   Me.ChoixTitre.DropDown
  Else
    ChoixTitre_click
  End If
End Sub
Private Sub ChoixTitre_click()
  a = f.Range("D2:E" & f.[D65000].End(xlUp).Row).Value
  Dim b(): ReDim b(1 To UBound(a))
  j = 0
  For i = 1 To UBound(a)
     If a(i, 2) = Me.ChoixTitre Then j = j + 1: b(j) = a(i, 1)
  Next i
  ReDim Preserve b(1 To j)
  Me.choixType.List = b
  Me.choixType.SetFocus
  If Val(Application.Version) > 10 Then SendKeys "{f4}"
End Sub
Private Sub ChoixType_click()
 For i = 2 To f.[D65000].End(xlUp).Row
  If f.Cells(i, "e") = Me.ChoixTitre And f.Cells(i, "d") = Me.choixType Then
    ligneEnreg = i
    For k = 1 To 3
      Me("textbox" & k) = f.Cells(ligneEnreg, k)
    Next k
    For k = 6 To 11
      Me("textbox" & k) = f.Cells(ligneEnreg, k)
    Next k
    End If
  Next i
End Sub
 Function SansDoublons(a())
   Set d = CreateObject("Scripting.Dictionary")
   For Each c In a
      d(c) = ""
   Next c
   b = d.keys
   SansDoublons = b
End Function

Cordialement

**boisgontierjacques** · 29/12/2016, 10h16

Bonjour,

cf PJ

JB

**graphikris** · 29/12/2016, 10h32

Bonjour et merci

Je viens de créer le bouton RAZ que j'ai associé a votre commande par contre les deux zones de recherches (listes déroulantes) ne se blanchissent pas.
Concernant la suppression du pavé numérique, le pb subsiste.
Comment faire pour imprimer le userform par l'intermediaire d'un bouton de commande ?

Encore merci pour votre aide
Cordialement

**graphikris** · 01/01/2017, 10h20

Envoyé par boisgontierjacques

Bonjour,

cf PJ

JB

Bonjour et bonne année,

Pourriez vous m'expliquer comment vous avez fait pour que les apostrophes et les parenthèses de la feuille soient identiques dans la liste deroulante du Userform1 ?
J'ai refait un Userform dans mon classeur original mais j'ai toujours les espaces aux parenthèses ainsi que les apostrophes comme dans l'image de mon post.
Par contre tjrs un pb avec la déconnection du pavé numerique à chaque fois que je declenche la macro.

Cordialement

**graphikris** · 27/04/2018, 12h13

Envoyé par boisgontierjacques

Bonjour,

cf PJ

JB

Bonjour,

Ayant dû ajouter et déplacer certaines colonnes, j'ai dû également modifier par logique le code VBA.
Mes colonnes sont désormais comme ceci :
Nom : Image1.png
Affichages : 1687
Taille : 59,5 Ko

Nom : Image1.png
Affichages : 1687
Taille : 59,5 Ko

Mon Userform est le suivant :
Nom : Image2.png
Affichages : 1847
Taille : 79,9 Ko

La liste intuitive déroulante du formulaire correspond désormais à la colonne I et le type de document à sélectionner correspondant à la colonne B.

Voici le code modifié mais dès que je sélectionne mon document dans la liste déroulante, la macro se bloque sur la ligne 38 ReDim Preserve b(1 To J)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Option Compare Text
Dim f, ligneEnreg, choix1()
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True 'Désactive le bouton FERMER du UserForm
End Sub
Private Sub Imprimer_Click()
    Me.PrintForm
End Sub
Private Sub Quitter_Click()
    Unload Me
    UserForm_Referentiel_doc.Show
End Sub
Private Sub UserForm_Initialize()
 
    Set f = Sheets("Suivi documentaire")
    ' I correspond à la colonne concernant l'intitulé des documents
    choix1 = Application.Transpose(f.Range("I2:I" & f.[I65000].End(xlUp).Row).Value)
    Me.ChoixTitre.List = SansDoublons(choix1)
    ligneEnreg = f.[I65000].End(xlUp).Row + 1
    Me.ChoixTitre.SetFocus
End Sub
Private Sub ChoixTitre_Change()
    If Me.ChoixTitre.ListIndex = -1 And IsError(Application.Match(Me.ChoixTitre, choix1, 0)) Then
        Me.ChoixTitre.List = Filter(SansDoublons(choix1), Me.ChoixTitre.Text, True, vbTextCompare)
        Me.ChoixTitre.DropDown
    Else
        ChoixTitre_click
    End If
End Sub
Private Sub ChoixTitre_click()
'B correspond au type de documents et I aux intitulés
    a = f.Range("B2:I" & f.[B65000].End(xlUp).Row).Value
    Dim b(): ReDim b(1 To UBound(a))
    J = 0
    For I = 1 To UBound(a)
        If a(I, 2) = Me.ChoixTitre Then J = J + 1: b(J) = a(I, 1)
    Next I
    ReDim Preserve b(1 To J)
    Me.choixType.List = b
    Me.choixType.SetFocus
    If Val(Application.Version) > 10 Then SendKeys "{f4}"
    Me.choixType = ""
    raz
End Sub
Private Sub ChoixType_click()
'B correspond au type de documents, "i" aux intitulés et "b" aux types de doc
    For I = 2 To f.[B65000].End(xlUp).Row
        If f.Cells(I, "i") = Me.ChoixTitre And f.Cells(I, "b") = Me.choixType Then
            ligneEnreg = I
            For K = 1 To 3
                Me("textbox" & K) = f.Cells(ligneEnreg, K)
            Next K
            For K = 6 To 11
                Me("textbox" & K) = f.Cells(ligneEnreg, K)
            Next K
        End If
    Next I
End Sub
Function SansDoublons(a())
    Set d = CreateObject("Scripting.Dictionary")
    For Each c In a
        d(c) = ""
    Next c
    b = d.keys
    SansDoublons = b
End Function
Sub raz()
    For K = 1 To 3
        Me("textbox" & K) = ""
    Next K
    For K = 6 To 11
        Me("textbox" & K) = ""
    Next K
End Sub

Cordialement,
Graphikris.

**unparia** · 28/04/2018, 08h34

Bonjour
l

a macro se bloque sur la ligne 38

Et tu t'abstiens bien évidemment de rapporter le message d'erreur ...
Bon --->>
Ta ligne 38 sera en erreur si (et uniquement si) J = 0 (et donc qu'aucun article ne correspond au critère défini en ta ligne 36)

**graphikris** · 28/04/2018, 10h01

Oui c'est vrai, j'ai omis d'indiquer le msg d'erreur :

Erreur d'éxécution '9':
l'indice n'appartient pas à la sélection

De plus je ne sais pas comment faire pour la case " Numerotation du document ", je dois concaténer la colonne C et la D
Je dois également rajouter une donnée au formulaire : " Numéro ancien document " (colonne G)

Sinon j'ai mis un extrait de mon fichier en PJ

Merci