Adaptation SI et RECHERCHEV en Macro

Version imprimable

14/09/2015, 12h49
Elisium

Adaptation SI et RECHERCHEV en Macro

Bonjour à tous,
je recherche en vain le moyen d'adapter une formule en macro (pour l'affecter sur des objets de type cases a cocher):
ma formule est ainsi décomposée:

Mon fichier se nom : Dossier-adduct.xlsm
la fonction désirée est : =SI(RECHERCHEV
la valeur recherchée : cellule B5

la table matrice : [Bdd.xlsx]Feuil1!$A$3:$I$5000
N° d'index de colonne : 10 (colonne J)

si la cellule en colonne J est non-vide = cocher la case à cocher

et le même code pour:
si la cellule est égale à 1 = cocher la case à cocher

En vous remerciant par avance pour votre aide ou infos.

Cdt.

JL
14/09/2015, 12h58
Kimy_Ire

Bonjour Elisium,

La fonction =RECHERCHEV est nommée VLookup en VBA (en anglais quoi).

Un exemple parmi les 200 000 que tu trouveras sur le net ! :ccool:

Cordialement,
Kimy
14/09/2015, 13h09
Daniel.C
Bonjour,

Ca peut ressembler à ça :
Code:

1 2 3 Dim Var Var = Application.VLookup([B5], Workbooks("Bdd.xlsx").Sheets("Feuil1").Range("A3:I5000"), 10, False) If Var <> "" Then checkbox1.Value = True
Ca dépend si la case à cocher est un contrôle de formulaire ou un contrôle ActiveX, s'il se trouve sur une feuille ou sur un userform.

Citation:

si la cellule est égale à 1 = cocher la case à cocher

Pas compris. Si la cellule est égale à 1, elle n'est pas vide... A moins que ce ne soit pas la même case à cocher.
14/09/2015, 13h20
Elisium

Merci à vous deux pour vos réponse,

et effectivement pour la cellule = à 1, ce n'est pas la même case a cocher.

Cdt.

JL
14/09/2015, 16h10
Elisium
Daniel C,
J’insère des "contrôle de formulaire" dans une feuille.
Mais je dois mal m'y prendre dans la procédure car j'ai des erreurs avec le code.
j'insère une case à cocher qui prend le nom par défaut : Case à cocher1_cliquer
je vais dans propriétés de l'objet puis, affecter une Macro
là il ouvre une fenêtre puis je clique sur "Nouvelle" et dans la fenêtre de code ,j'insere le code:
Code:

1 2 3 4 5 Sub Caseàcocher1_Cliquer() Dim Var Var = Application.VLookup([B5], Workbooks("Mediapost.xlsx").Sheets("Feuil1").Range("A3:I5000"), 10, False) If Var <> "" Then checkbox1.Value = True End Sub
mais lorsque le fichier source est fermé, il me met une erreur "l'élément portant ce nom est introuvable"
et lorsqu'il est ouvert en même temps, il bug sur " incompatibilite de type"

Peut-tu me dire si ma procédure est bonne,
et te faut-il les fichiers source et cible pour y voir plus clair ?

Merci

JL
14/09/2015, 16h27
Daniel.C

Le fichier doit être ouvert.
14/09/2015, 16h30
Elisium

Et l'erreur que j'ai lorsqu'il est ouvert ? "incompatibilité de type" de quoi cela peut provenir?

Bonjour,

Attetion, ici il y a erreur :

Citation:

la table matrice : [Bdd.xlsx]Feuil1!$A$3:$I$5000
N° d'index de colonne : 10 (colonne J)

Avec un tableau de la colonne A à la colonne I l'index ne peut pas être 10 (colonne J) mais au max 9 !
Une piste avec lecture dans le classeur fermé. Attention, il faut adapter le nom des contrôles appelant au niveau du "Select Case Application.Caller" (dans mon exemple, "Bouton 1" et "Bouton 2") ainsi que le nom des cases à cocher (dans mon exemple, "Case à cocher 1" et "Case à cocher 2") . A tes boutons tu affectes la procédure "Test" à tous les deux et "Application.Caller" permet de savoir lequel appelle la proc :

Code:

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
 
Sub Test()
 
    Dim Plage As Range
    Dim MonDossier As String
    Dim Classeur As String
    Dim Feuille As String
    Dim ValCherchee
    Dim Valeur
    Dim IndexColonne As Integer
    Dim Exact As Boolean
 
    MonDossier = "D:\Mon Dossier\" 'adapter le chemin
    Classeur = "Bdd.xlsx"
 
    Feuille = "Feuil1"
 
    Set Plage = Range("A3:M5000") 'ici, jusqu'à M pour Index 10 (colonne J)
 
    ValCherchee = Range("B5").Value 'en B5 de la feuille active
 
    IndexColonne = 10 'colonne J
 
    Exact = False 'false pour correspondance exacte
 
    'appel de la fonction
    Valeur = RECHERCHE_VERT(MonDossier, _
                            Classeur, _
                            Feuille, _
                            ValCherchee, _
                            Plage, _
                            IndexColonne, _
                            Exact)
 
    'si pas de correspondance (l'erreur à été gérée dans la fonction) donc, message et fin !
    If Valeur = "Aucune valeur correspondante à '" & ValCherchee & "' !" Then
 
        MsgBox Valeur
        Exit Sub
 
    Else
 
        'adapter le nom du contrôle appelant !!!
        Select Case Application.Caller
 
            Case "Bouton 1"
 
                'si c'est le bouton 1 et que la valeur retournée est égale à 1, la case est cochée sinon, décochée
                With ActiveSheet.Shapes("Case à cocher 1").ControlFormat
                    If Valeur = 1 Then .Value = 1 Else .Value = 0
                End With
 
            Case "Bouton 2"
 
                'si c'est le bouton 2 et que la valeur retournée est <> "", la case est cochée sinon, décochée
                With ActiveSheet.Shapes("Case à cocher 2").ControlFormat
                    If Valeur <> "" Then .Value = 1 Else .Value = 0
                End With
 
        End Select
 
    End If
 
End Sub
 
Public Function RECHERCHE_VERT(Chemin As String, _
                               Classeur As String, _
                               Feuille As String, _
                               ValRecherchee As Variant, _
                               Plage As Range, _
                               ColonneIndex As Integer, _
                               ValExacte As Boolean)
 
    Dim Valeur
    Dim Exact As String
 
    Select Case ValExacte: Case False: Exact = "FALSE": Case Else: Exact = "TRUE": End Select
 
    Valeur = ExecuteExcel4Macro("VLOOKUP(""" & ValRecherchee & _
                                         """,'" & Chemin & _
                                         "[" & Classeur & _
                                         "]" & Feuille & _
                                         "'!" & Plage.Address(1, 1, xlR1C1) & _
                                         "," & ColonneIndex & _
                                         "," & Exact & ")")
 
    If IsError(Valeur) Then
 
        RECHERCHE_VERT = "Aucune valeur correspondante à '" & ValRecherchee & "' !"
 
    Else
 
        RECHERCHE_VERT = Valeur
 
    End If
 
End Function

14/09/2015, 18h41
Elisium

Theze,

Vraiment Merci pour ton code,
effectivement la valeur recherchée était en dehors de la table matrice (erreur de débutant)
mais déjà avec 3 lignes de code j'avais du mal alors là !!!
je pense avoir bien adapté llà o l fallait modifier mais ce que je ne pige vraiment pas c'est lorsque tu dis:

Citation:

il faut adapter le nom des contrôles appelant au niveau du "Select Case Application.Caller" (dans mon exemple, "Bouton 1" et "Bouton 2") ainsi que le nom des cases à cocher (dans mon exemple, "Case à cocher 1" et "Case à cocher 2")

.

Voici comment je fais pour créer mes cases a cocher
DEVELLOPEUR, INSERER, Case a cocher (contrôle de formulaire), et je crée l'objet sur ma feuille. (il porte le nom case a cocher1)
ensuite je clique droit dessus, et affecter une macro.
et c'est là que je m'enbrouille.

Aurais tu la patience de me doner quelques tuyaux pour créer mes boutons et ffecter ton code.

Merci par avance.

JL
15/09/2015, 07h44
Theze

Bonjour,

Quand tu as posés un contrôle formulaire sur ta feuille, tu vas voir son nom apparaître dans la zone de nom (à gauche de la barre de formules) et là, tu peux changer son nom de façon à l'adapter comme tu veux (tu change le nom si tu le désire puis appui sur la touche Entrée pour valider) ou alors, tu le copie et tu remplace les noms que j'ai entrés dans le code. Quand tu fais clic droit sur le contrôle tu choisis Affecter une macro... tu clique alors sur la procédure "Test" et ceci pour les deux contrôles qui doivent définir l'état des deux cases à cocher correspondantes.
Si tu n'y arrive pas, poste un classeur et je te le renverrai.

Hervé.
15/09/2015, 10h41
Elisium

2 pièce(s) jointe(s)

Theze,
Merci pour l'explication que je pense avoir suivi mais malgré avoir adapté ton code, les cases a cocher ne s'active pas automatiquement.
Je me permet de te joindre deux fichiers
Bdd.xlsx (source)
Dossier Adduct (cible) dans lequel j'ai indiqué des explications.
j'ai crée deux case à cocher (Bouton 1 et Bouton 2) et j'ai affecté la macro Test
mais malgré les données saisies dans la Bdd, ces deux case à cocher ne s'active pas automatiquement.

Encore merci par avance pour ton aide.

Cdt.
J-L
17/09/2015, 08h16
Theze

2 pièce(s) jointe(s)

Bonjour,

Je te retourne tes fichiers avec une autre approche ! La recherche s'effectue automatiquement une fois que tu as entrés le code voulu en cellule A6 !

Hervé.
17/09/2015, 15h32
Elisium

These,
Wouah !! merci beaucoup
effectivement, le code est complètement différent.
J'ai essayé mais lorsque je veux modifier la cellule A6 pour saisir une autre réf ça bug. erreur 3706 Provider introuvable.

d'autre part, (tu vas me prendre pour un casse .... à force !!!!)
le fichier dossier adduct n'étant qu'un exemple, celui sur lequel je vais travailler aura beaucoup plus de cases à cocher, en correspondance avec d'autres colonnes de la Bdd,
(mais toujours le même type de fonction : "si cellule de la Bdd = quelque chose" ou bien "si cellule est vide ou non-vide" comme ceux que tu as fais.

Pourrais-tu m'indiquer quelle est la partie que je dois ajouter et à quel endroit

Merci par avance.

JL

Re,

Remplace le code existant par celui-ci pour voir si tu as toujours l'erreur. Je suis en Excel 2003 et 2007 et ça fonctionne très bien par contre tu es en Excel 2013, ça peut venir de là :

Code:

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
 
Private Sub ConnectCLasseur(ConnectCL As Object, _
                            fichier As String, _
                            Optional Rs)
 
    Set ConnectCL = CreateObject("ADODB.Connection")
 
    If Not IsMissing(Rs) Then
        Set Rs = CreateObject("ADODB.Recordset")
    End If
 
 
    ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                   "Data Source=" & fichier & ";" & _
                   "Extended Properties=""Excel 12.0;HDR=YES;IMEX=2;"""
 
End Sub
 
Sub RecupValeurs(ValCherchee As String)
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim Champ As Object
    Dim Dossier As String
    Dim Classeur As String
    Dim NomFeuille As String
    Dim Plage As String
    Dim Tbl() As String
    Dim I As Long
    Dim J As Long
 
    Dossier = "D:\Test\" 'adapter le chemin
    Classeur = "Bdd.xlsx"
 
    NomFeuille = "Feuil1"
 
    Plage = "A2:L1000"
 
    'contôle si existe
    If Dir(Dossier & Classeur) = "" Then
 
        MsgBox "Le fichier '" & Classeur & "' est introuvable dans le dossier '" & Dossier & "' !"
        Exit Sub
 
    End If
 
    'connexion
    ConnectCLasseur ConnectCL, Dossier & Classeur, Rs
 
    With Rs
 
        .CursorType = 1
        .LockType = 3
        .Open "SELECT * FROM `" & NomFeuille & "$" & Plage & "` ", ConnectCL
        .MoveFirst
 
 
        ReDim Tbl(1 To .RecordCount, 1 To .Fields.Count)
 
        Do While Not .EOF
 
            I = I + 1
 
            For Each Champ In .Fields
 
                J = J + 1
                On Error Resume Next
                Tbl(I, J) = Champ.Value
 
            Next
 
            J = 0
 
            .MoveNext
 
        Loop
 
    End With
 
    ConnectCL.Close
 
    For I = 1 To UBound(Tbl, 2)
 
        If Tbl(I, 1) = ValCherchee Then
 
            With ActiveSheet.Shapes("Case à cocher 1").ControlFormat
                If Tbl(I, 9) <> "" Then .Value = 1 Else .Value = 0
            End With
 
            With ActiveSheet.Shapes("Case à cocher 2").ControlFormat
                If Tbl(I, 10) <> "" Then .Value = 1 Else .Value = 0
            End With
 
            With ActiveSheet.Shapes("Case à cocher 3").ControlFormat
                If Tbl(I, 11) = "1" Then .Value = 1 Else .Value = 0
            End With
 
            With ActiveSheet.Shapes("Case à cocher 4").ControlFormat
                If Tbl(I, 11) = "2" Then .Value = 1 Else .Value = 0
            End With
 
            Exit For
 
        End If
 
    Next I
 
End Sub

Hervé.

24/09/2015, 17h23
Elisium
Bonsoir Hervé,

Merci pour ton code new version,
J'ai essayé le 1er sur un autre PC (Seven / office 2013) et ton 1er code fonctionne nickel.
Donc ce n'était pas ton code qui pose Pb mais bien mon Pc (8.1 / office 2013).
J'ai desinstall, réinstall office et ça Passe maintenant.

Encore une fois Merci pour toute ton aide.

PS: Pour la derniere demande: Comme je te le disais plus haut je vais avoir plus de cases a cocher sur le classeur final.
donc pourrais-tu m'indiquer quelle partie de ton code dois-je dupliquer si je souhaite rajouter une case a cocher en plus.

je suppose qu'il y a la partie:
Code:

1 2 3 With ActiveSheet.Shapes("Case à cocher 1").ControlFormat If Tbl(I, 9) <> "" Then .Value = 1 Else .Value = 0 End With
en remplacant les parties en rouge ?
mais je ne sais pas s'il y à autre chose.

Merci

Jean-Luc
25/09/2015, 07h31
Theze
Bonjour,

Citation:

en remplacant les parties en rouge ?

Oui, tu adapte le nom de la case à cocher et le champ correspondant dans le tableau sachant que l'indice 1 "Tbl(I, 1)" correspond à ton 1er champ (REFERENCE) et que l'indice 12 correspond à ton dernier champ (ADDUCTION_EXISTANTE dans ton classeur exemple).
C'est dans la condition que tu adapte à ce que tu désire :
Code:

1 2 3 4 If Tbl(I, 3) <> "" Then If Tbl(I, 3) = 6 Then 'etc...
25/09/2015, 12h48
Elisium

Bonjour Hervé,

super,

Encore merci pour toute ton aide.
Bonne journée.

Jean-Luc