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

[Coralie01120]

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.

 

[job75]

Bonjour Coralie01120,

Je ne comprends pas votre BDD Papiers.

Comment un papier comme AAA peut avoir tous les Type de support, Forme du support, Etat de surface ?

A+

 

[Coralie01120]

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+

 

[job75]

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

Dans ce cas utilisez des cases d'option (ou des OptionButtons ActiveX).

Et que voulez-vous en faire exactement ?

 

[Coralie01120]

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]

Voyez le fichier joint et cette macro affectée à chaque case d'option :

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.

 

[job75]

J'ai testé en copiant les lignes 3:6 de la BDD sur 10 000 lignes.

La macro s'exécute chez moi en 0,4 seconde, c'est très satisfaisant.

 

[job75]

Bonjour Coralie01120, le forum,

Il peut être utile d'effacer toutes les options, voyez ce fichier (2) :

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 :

If i = 0 Then ReDim a(0): a(0) = Chr(1)

A+

 

[job75]

Fichier (3) avec pilotage de la liste de validation en C22 :

        dest.Validation.Add xlValidateList, Formula1:="=Liste"
        dest.Validation.InCellDropdown = UBound(b) 'affiche ou masque la flèche

 

[Coralie01120]

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.

 

[job75]

Dans la feuille BDD Papiers l'ordre des colonnes n'a aucune importance.

 

[Coralie01120]

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]

Les choix doivent être dans une liste de validation, c'est fait pour ça.

Pourquoi les mettre dans des cellules, disjointes en plus ?

 

[Coralie01120]

C'est pour une question de lisibilité. C'est plus lisible pour l'utilisateur d'avoir les papiers à la suite plutôt que dans une liste déroulante.

 

[job75]

OK, dans ce fichier (4) il n'y a plus de liste de validation, les choix sont affichés à partir de la ligne 22 :

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.