Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Cases à cocher et BDD / macro pour faire le lien

Coralie01120

XLDnaute Occasionnel
Bonjour Le Forum,

Je cherche à créer un questionnaire qui me permettrait d'identifier en automatique le papier à utiliser.

Voici le sujet : J'ai un onglet BDD Papiers qui liste l'ensemble de mes références papier (AAA, BBB, CCC, DDD ...). Les éléments à l'intérieur ne varient pas. Je peux seulement rajouter des références de papiers.

Mon autre onglet Besoin Client, me permet de renseigner le besoin du client et en fonction des cases cochées cela me donne le nom du papier à utiliser.

Comment faire pour renseigner les cellules du choix 1 / 2 / 3 avec cases cochées ?

Je bloque sur ce sujet... Est ce mieux d'utiliser des listes déroulantes avec RechercheV ? Une macro pourrait elle répondre davantage à mon besoin ?

Merci pour votre aide.

Bon après-midi.
 

Pièces jointes

  • Test BDD.xls
    41.5 KB · Affichages: 26
Solution
Bonjour Coralie01120,

Dans ce fichier (5) ce code masque les cases de Forme si la case Permanent n'est pas sélectionnée :
VB:
'---affiche/masque les cases du groupe Forme---
masque = F.DrawingObjects("Case d'option 12").Value = xlOff 'case Permanent non sélectionnée
For Each o In F.DrawingObjects(Array("Case d'option 09", "Case d'option 10", "Case d'option 11")) 'cases Plat Courbé Conique
    If masque Then o.Value = xlOff 'désélectionne
    o.Visible = Not masque
Next o
Mais je n'en vois pas vraiment l'intérêt...

A+

Coralie01120

XLDnaute Occasionnel
Bonjour Job75,

Ma BDD papiers est un exemple.
Mais en soit il est possible qu'un papier soit compatible avec tous les types de supports, formes et état de surface.

Par contre dans l'onglet Besoin client, il y aura seulement une case de cochée puisque le besoin correspond à un produit.

A+
 

Coralie01120

XLDnaute Occasionnel
En fonction des cases cochées je souhaite savoir quel papier utiliser dans les cellules Choix 1 / Choix 2 / Choix 3 ?
Est ce qu'avec des cases à cocher et ma BDD j'arrive à faire apparaitre le papier (comme avec une rechercheV) ?
 

job75

XLDnaute Barbatruc
Voyez le fichier joint et cette macro affectée à chaque case d'option :
VB:
Sub Choix()
Dim F As Worksheet, dest As Range, o As Object, a$(), i%, ub%, r As Range, b$(), j&, liste
Set F = Sheets("Besoin Client")
Set dest = F.[C22] 'cellule des résultats, à adapter
For Each o In F.DrawingObjects
    If LCase(o.Name) Like "*option*" Then
        If o.Value = 1 Then
            ReDim Preserve a(i) 'base 0
            a(i) = o.Text
            i = i + 1
        End If
    End If
Next
ub = UBound(a)
For Each r In Sheets("BDD Papiers").[A1].CurrentRegion.Rows
    For i = 0 To ub
        If Application.CountIf(r, a(i)) = 0 Then GoTo 1
    Next i
    ReDim Preserve b(j) 'base 0
    b(j) = r.Cells(1)
    j = j + 1
1 Next r
With Sheets("Choix") 'feuille auxiliaire
    .[A1].CurrentRegion.Delete xlUp 'RAZ
    dest = "" 'RAZ
    If j Then
        '---transposition---
        ReDim liste(1 To UBound(b) + 1, 1 To 1)
        For j = 0 To UBound(b)
            liste(j + 1, 1) = b(j)
        Next j
        '---liste de validation---
        With .[A1].Resize(UBound(liste))
            .Value = liste
            .Name = "Liste"
        End With
        F.Visible = xlSheetVisible 'au cas où...
        dest = .[A1] '1er terme de la liste en C22
        Application.Goto dest
    End If
End With
End Sub
Les résultats, c'est à dire les choix possibles, sont dans la liste de validation en C22.
 

Pièces jointes

  • Test BDD(1).xls
    67.5 KB · Affichages: 17

job75

XLDnaute Barbatruc
Bonjour Coralie01120, le forum,

Il peut être utile d'effacer toutes les options, voyez ce fichier (2) :
VB:
Sub Effacer()
Dim o As Object
For Each o In ActiveSheet.DrawingObjects
    If LCase(o.Name) Like "*option*" Then o.Value = xlOff
Next
Choix
End Sub
Dans la macro Choix :
VB:
If i = 0 Then ReDim a(0): a(0) = Chr(1)
A+
 

Pièces jointes

  • Test BDD(2).xls
    72 KB · Affichages: 7

job75

XLDnaute Barbatruc
Fichier (3) avec pilotage de la liste de validation en C22 :
VB:
        dest.Validation.Add xlValidateList, Formula1:="=Liste"
        dest.Validation.InCellDropdown = UBound(b) 'affiche ou masque la flèche
 

Pièces jointes

  • Test BDD(3).xls
    72 KB · Affichages: 6

Coralie01120

XLDnaute Occasionnel
Bonjour Job75,

Super, tout fonctionne bien et de façon très rapide.
Si je souhaite ajouter des colonnes dans l'onglet BDD Papiers avec des options dans l'onglet Besoin client y'a t'il un ordre à respecter ?
Que dois-je modifier dans la macro ? (J'ai essayé de la comprendre mais ce n'est pas évident pour moi).

Je vous remercie pour votre aide.
 

Coralie01120

XLDnaute Occasionnel
Job75,

Je n'arrive pas à faire apparaitre les choix à la suite. Il reste en liste déroulante.
Que faut il corriger dans la macro pour que le premier papier soit en C22, le 2eme en C24 et le 3eme en C26 et ainsi de suite ?
 

job75

XLDnaute Barbatruc
OK, dans ce fichier (4) il n'y a plus de liste de validation, les choix sont affichés à partir de la ligne 22 :
VB:
Sub Choix()
Dim F As Worksheet, dest As Range, o As Object, a$(), i%, ub%, r As Range, b$(), j&, liste
Set F = Sheets("Besoin Client")
Set dest = F.[B22] '1ère cellule des résultats, à adapter
For Each o In F.DrawingObjects
    If LCase(o.Name) Like "*option*" Then
        If o.Value = xlOn Then
            ReDim Preserve a(i) 'base 0
            a(i) = o.Text
            i = i + 1
        End If
    End If
Next
If i = 0 Then ReDim a(0): a(0) = Chr(1)
ub = UBound(a)
For Each r In Sheets("BDD Papiers").[A1].CurrentRegion.Rows
    For i = 0 To ub
        If Application.CountIf(r, a(i)) = 0 Then GoTo 1
    Next i
    ReDim Preserve b(j) 'base 0
    b(j) = r.Cells(1)
    j = j + 1
1 Next r
'---restitution---
Application.ScreenUpdating = False
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
dest(1, 2).Resize(F.Rows.Count - dest.Row + 1, 4).HorizontalAlignment = xlCenterAcrossSelection 'centrage sur les colonnes C:F
dest.Resize(F.Rows.Count - dest.Row + 1, 2).ClearContents 'RAZ
If j Then
    ReDim liste(1 To 2 * UBound(b) + 1, 1 To 2)
    For j = 1 To UBound(liste) Step 2
        liste(j, 1) = "Choix " & (j + 1) / 2
        liste(j, 2) = b((j - 1) / 2)
    Next j
    dest.Resize(UBound(liste), 2) = liste
End If
End Sub
La MFC sur les 4 colonnes C:F colore en jaune les résultats.
 

Pièces jointes

  • Test BDD(4).xls
    67.5 KB · Affichages: 8
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…