XL 2016 Affichage par liste deroulante

fosters

XLDnaute Occasionnel
Bonjour à tous, le forum,


Je vous sollicite pour m’aider à résoudre deux points que je rencontre avec un affichage par liste déroulante

1 : Je souhaiterais dans un bon de commande afficher les articles d’un fournisseur en sélectionnant ce fournisseur par liste déroulante.

(Code article ; Désignation ; Conditionnement ; Prix Vente) je remplirais les quantités manuellement.


2 : Lors de la validation par un bouton de commande n’afficher que les lignes qui contienne des quantités.


Je joins un petit fichier pour illustrer ma demande

Je vous remercie de m’indiquer les étapes à suivre.


Bien cordialement
 

Pièces jointes

  • BDC.xlsx
    243.9 KB · Affichages: 41

job75

XLDnaute Barbatruc
Bonsoir fosters, JHA, ChTi160,

Voyez le fichier joint et le code de la feuille BDC :
Code:
Private Sub CommandButton1_Click() 'Valider
Dim c As Range
For Each c In [F13:F21] 'plage à adapter
    c.EntireRow.Hidden = IsEmpty(c)
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim F As Worksheet, i&, j As Variant
Set F = Sheets("Liste (à masquer)")
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With [B13:F21] 'plage à adapter
    If Not Intersect(Target, [C5]) Is Nothing Then
        .Rows.Hidden = False 'affiche tout
        .ClearContents 'RAZ
        F.[A:E].Clear 'RAZ
        With Sheets("Articles").[A1].CurrentRegion
            .Sort .Columns(3), xlAscending, Header:=xlYes 'tri alphabétique
            .AutoFilter 1, [C5] 'filtre automatique
            .SpecialCells(xlCellTypeVisible).Copy F.[A1]
            If .Parent.FilterMode Then .Parent.ShowAllData
        End With
        ThisWorkbook.Names.Add "Liste", "=#REF!"
        With F.[A1].CurrentRegion
            If .Rows.Count > 1 Then .Cells(2, 3).Resize(.Rows.Count - 1).Name = "Liste" 'plage nommée
        End With
    End If
    If Not Intersect(Target, .Cells) Is Nothing Then
        For i = 1 To .Rows.Count
            j = Application.Match(.Cells(i, 2), F.Columns(3), 0)
            If IsNumeric(j) Then .Cells(i, 1).Resize(, 4) = F.Cells(j, 2).Resize(, 4).Value2 _
                Else .Cells(i, 1).Resize(, 4) = ""
        Next
    End If
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Bonne nuit.
 

Pièces jointes

  • BDC(1).xlsm
    262.5 KB · Affichages: 31
Dernière édition:

fosters

XLDnaute Occasionnel
Bonjour JHA, job75 ChTi160,

Le forum

Merci pour vos réponses, je suis confronté à problème de riche, lol, toute vos propositions sont excellentes et conviennent à mon petit projet.

Je vais créer un bouton « enregistré sous » pour l’archiver dans un dossier « Bon de commandes »

Si je peux me permettre de vos solliciter de nouveaux est-il possible d’enregistré le bon de commande de façon suivante : « BDC,nomfournisseurs,date »

Merci encore.

Bonne journée

Bien cordialement
 

job75

XLDnaute Barbatruc
Bonjour fosters, le forum,

Utilisez le bouton pour enregistrer le bon de commande :
Code:
Private Sub CommandButton1_Click() 'Enregistrer
If [C5] = "" Then Exit Sub
Dim dossier$, c As Range
dossier = ThisWorkbook.Path & "\Bons de commandes\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Dir(dossier, vbDirectory) = "" Then MkDir dossier 'crée le dossier s'il n'existe pas
For Each c In [F13:F21] 'plage à adapter
    c.EntireRow.Hidden = IsEmpty(c)
Next
With Workbooks.Add(xlWBATWorksheet).Sheets(1)
    Cells.Copy .[A1]
    .UsedRange = .UsedRange.Value 'supprime les formules
    .Cells.Validation.Delete 'supprime les listes de validation
    .[E13:E21,G13:G22].NumberFormat = "_-* # ##0.00 €_-;-* # ##0.00 €_-;_-* "" - ""?? €_-;_-@_-" 'format Comptabilité
    .Parent.SaveAs dossier & "BDC " & [C5] & Format([E2], " dd-mm-yyyy")
    .Parent.Close
End With
End Sub
PS : j'ai aussi ajouté une ligne dans la macro Worksheet_Change pour créer le lien hypertexte en C10.

Fichier (2).

A+
 

Pièces jointes

  • BDC(2).xlsm
    268.3 KB · Affichages: 32

fosters

XLDnaute Occasionnel
Bonsoir job75, bonsoir le forum,


Super boulot, j'ai adapter le fichier ce soir ca fonctionne très bien , l'archivage est top.

Petite question a quel endroit de la macro je peux changer l'extension de l'archivage de xlsx en pdf.

Par contre je n'ai pas compris le "PS:j'ai aussi ajouté une ligne dans la macro Worksheet_Change pour créer le lien hypertexte en C10."


Merci d'avoir pris le temps de me répondre


Bonne nuit

Bien cordialement
 

job75

XLDnaute Barbatruc
Bonjour fosters, le forum,

Fichier (2 bis) avec :
Code:
Private Sub CommandButton1_Click() 'Enregistrer
If [C5] = "" Then Exit Sub
Dim dossier$, c As Range
dossier = ThisWorkbook.Path & "\Bons de commandes\" 'à adapter
If Dir(dossier, vbDirectory) = "" Then MkDir dossier 'crée le dossier s'il n'existe pas
For Each c In [F13:F21] 'plage à adapter
    c.EntireRow.Hidden = IsEmpty(c)
Next
Me.ExportAsFixedFormat xlTypePDF, dossier & "BDC " & [C5] & Format([E2], " dd-mm-yyyy"), Quality:=xlQualityStandard
End Sub
Pour le lien hypertexte c'est la 3ème ligne de la macro...

Bonne journée.

A+
 

Pièces jointes

  • BDC(2 bis).xlsm
    268 KB · Affichages: 37

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof