Intégrer articles dans un bon de commande

Le 25/10/2021 à 08:28

Bonjour à toutes et tous,

Je sèche un peu sur une fonction ..., Dans un classeur, je fais une gestion de stock, avec macro pour les entrées, sorties, etc.

Lorsque l'article est créé, il est dans le tableau "Inventaire" avec surbrillance pour signaler qu'il est en niveau bas.

Je voudrais que lorsque l'article est en stock mini, qu'il se mette sur la feuille "bon de commande" automatiquement et sur ma page accueil qui me sert de tableau de bord.

Je vous joints le classeur .

Merci d'avance,

34id-10829.xlsm (197.46 Ko)
Le 26/10/2021 à 14:09

Bonjour steph59,

Je n'ai pas trouvé de feuille "Bon de commande" dans ton classeur...

Le 26/10/2021 à 18:29

bonjour

Merci de ta réponse, en effet elle est à créer.

C’est juste un retour de ligne que je voudrais car ce sera en commande interne, pour que je puisse savoir les articles à commander.

Cordialement

Le 26/10/2021 à 19:59

steph59,

Désolé, je ne concrétise pas ce que tu entends par

C’est juste un retour de ligne que je voudrais

Peux-tu expliciter ?

Le 26/10/2021 à 21:50

Je voudrais avoir uniquement les articles en rupture ( surbrillance rouge et marron ) de ma feuille inventaire, sur une feuille séparée (commande).

Merci d’avance

Stephane

Le 27/10/2021 à 14:13

Bonjour Steph59,

Une précision : lorsque la colonne "Stock d'alerte' est vide, cela signifie qu'il n'y a pas de seuil et dans ce cas, l'article en rupture est ignoré ou bien que le seuil est à '0' et si le stock de l'article est à 0 on doit le sortir ?

Le 27/10/2021 à 15:15

Steph59,

Je te propose la macro suivante :

Sub RechRuptures()
    Dim oRangeFrom As Range, oCell As Range, oRangeTo As Range, oSheetTo As Worksheet
    Dim aArticlesRuptures() As String
    Dim lNb As Long, i As Long

    On Error Resume Next
    'On tente d'affecter la feuille "Commandes"
    Set oSheetTo = ThisWorkbook.Worksheets("Commandes")
    On Error GoTo 0
    'Si la feuille n'existe pas, on la créée comme première feuille du classeur
    If oSheetTo Is Nothing Then
        Set oSheetTo = ThisWorkbook.Worksheets.Add()
        oSheetTo.Name = "Commandes"
    Else
        'Si elle existe, on efface son contenu
        oSheetTo.Cells.Clear
    End If

    'On parcourt la feuille tableau "Inventaire"
    Set oRangeFrom = ThisWorkbook.Names("Inventaire").RefersToRange
    For Each oCell In oRangeFrom.Columns(3).Cells
        'Si le seuil est atteint alors on indique stocke l'article dans le tableau local
        If Not IsEmpty(oCell.Offset(, 2).Value) And Not IsEmpty(oCell.Value) Then
            If oCell.Value <= IIf(IsNull(oCell.Offset(, 1).Value), 0, oCell.Offset(, 1).Value) Then
                ReDim Preserve aArticlesRuptures(lNb)
                aArticlesRuptures(lNb) = oCell.Offset(, 2).Value
                lNb = lNb + 1
            End If
        End If
    Next
    'On recopie le tableau local dans la feuille
    oSheetTo.Range("A1").Value = "Articles à commander au " & Format(CDate(Now()), "dd/mm/yyyy")

    For i = 0 To UBound(aArticlesRuptures)
        Set oRangeTo = oSheetTo.Range("A" & CStr(i + 2))
        oRangeTo.Value = aArticlesRuptures(i)
    Next

    'On fait le ménage
    Set oCell = Nothing
    Set oRangeTo = Nothing
    Set oRangeFrom = Nothing
    Set oSheetTo = Nothing
End Sub
Le 28/10/2021 à 15:24

Merci Gérard,

J'ai intégrer ca marche super par contre je n'ai que la colonne référence qui s'affiche, si j'aurais pu avoir la colonne pièces ou me dire comment l'intégrer.

Merci

Steph

Le 28/10/2021 à 18:53

Bonsoir Steph,

Pour avoir le libellé de la pièce, voici une nouvelle proposition :

Sub RechRuptures()
    Dim oRangeFrom As Range, oCell As Range, oRangeTo As Range, oSheetTo As Worksheet
    Dim aArticlesRuptures() As String
    Dim lNb As Long, i As Long

    On Error Resume Next
    'On tente d'affecter la feuille "Commandes"
    Set oSheetTo = ThisWorkbook.Worksheets("Commandes")
    On Error GoTo 0
    'Si la feuille n'existe pas, on la créée comme première feuille du classeur
    If oSheetTo Is Nothing Then
        Set oSheetTo = ThisWorkbook.Worksheets.Add()
        oSheetTo.Name = "Commandes"
    Else
        'Si elle existe, on efface son contenu
        oSheetTo.Cells.Clear
    End If

    'On parcourt la feuille tableau "Inventaire"
    Set oRangeFrom = ThisWorkbook.Names("Inventaire").RefersToRange
    For Each oCell In oRangeFrom.Columns(3).Cells
        'Si le seuil est atteint alors on indique stocke l'article dans le tableau local
        If Not IsEmpty(oCell.Offset(, 2).Value) And Not IsEmpty(oCell.Value) Then
            If oCell.Value <= IIf(IsNull(oCell.Offset(, 1).Value), 0, oCell.Offset(, 1).Value) Then
                ReDim Preserve aArticlesRuptures(2, lNb)
                aArticlesRuptures(1, lNb) = oCell.Offset(, 2).Value
                aArticlesRuptures(2, lNb) = oCell.Offset(, -3).Value
                lNb = lNb + 1
            End If
        End If
    Next
    'On recopie le tableau local dans la feuille
    oSheetTo.Range("A1").Value = "Articles à commander au " & Format(CDate(Now()), "dd/mm/yyyy")

    For i = 0 To UBound(aArticlesRuptures)
        Set oRangeTo = oSheetTo.Range("A" & CStr(i + 2))
        oRangeTo.Value = aArticlesRuptures(1, i)
        Set oRangeTo = oSheetTo.Range("B" & CStr(i + 2))
        oRangeTo.Value = aArticlesRuptures(2, i)
    Next

    'On fait le ménage
    Set oCell = Nothing
    Set oRangeTo = Nothing
    Set oRangeFrom = Nothing
    Set oSheetTo = Nothing
End Sub
Le 28/10/2021 à 21:32

Merci Gérard pour ta rapidité et ton aide, je te tire mon chapeau.

Je vais essayer ça demain et reviens vers toi.

Cordialement

Stephane

Le 02/11/2021 à 13:03

Bonjour Gérard,

Je reviens vers toi pour la macro.

J'ai essayé, j'ai bien les articles et les réf, en revanche je n'ai que 3 articles inscrit dans la page commande.

En modifiant la ligne: ReDim Preserve aArticlesRuptures(2, lNb) en mettant 10 par exemple j'ai les 10 premiers articles de la feuille.

Cependant il me mets même les articles n'étant pas en rupture des 10 premiers lignes.

Je voudrais uniquement les articles étant en rupture dans l'inventaire.

Merci pour ton aide

Cdlt, steph

Le 02/11/2021 à 13:51

Bonjour Steph29,

Peux-tu joindre ton classeur dans son état de développement actuel ?

Le 03/11/2021 à 08:32
8copie-de-gestion-de-stock2.zip (1.08 Mo)

Bonjour Gérard,

Voici le classeur

cdlt

Le 03/11/2021 à 14:31

Bonjour Steph,

J'ai rectifié le code (...pb avec les index du tableau local 'array') :

Sub RechRuptures()
    Dim oRangeFrom As Range, oCell As Range, oRangeTo As Range, oSheetTo As Worksheet
    Dim aArticlesRuptures() As String
    Dim lNb As Long, i As Long

    On Error Resume Next
    'On tente d'affecter la feuille "Commandes"
    Set oSheetTo = ThisWorkbook.Worksheets("Commandes")
    On Error GoTo 0
    'Si la feuille n'existe pas, on la créée comme première feuille du classeur
    If oSheetTo Is Nothing Then
        Set oSheetTo = ThisWorkbook.Worksheets.Add()
        oSheetTo.Name = "Commandes"
    Else
        'Si elle existe, on efface son contenu
        oSheetTo.Cells.Clear
    End If

    'On parcourt la feuille tableau "Inventaire"
    Set oRangeFrom = ThisWorkbook.Names("Inventaire").RefersToRange
    For Each oCell In oRangeFrom.Columns(3).Cells
        'Si le seuil est atteint alors on indique stocke l'article dans le tableau local
        If Not IsEmpty(oCell.Offset(, 2).Value) And Not IsEmpty(oCell.Value) Then
            If oCell.Value <= IIf(IsNull(oCell.Offset(, 1).Value), 0, oCell.Offset(, 1).Value) Then
                ReDim Preserve aArticlesRuptures(1, lNb)                'Rectif GVS du 03/11/2021
                aArticlesRuptures(0, lNb) = oCell.Offset(, 2).Value     'Rectif GVS du 03/11/2021
                aArticlesRuptures(1, lNb) = oCell.Offset(, -3).Value    'Rectif GVS du 03/11/2021
                lNb = lNb + 1
            End If
        End If
    Next
    'On recopie le tableau local dans la feuille
    oSheetTo.Range("A1").Value = "Articles à commander au " & Format(CDate(Now()), "dd/mm/yyyy")

    For i = 0 To UBound(aArticlesRuptures(), 2)                         'Rectif GVS du 03/11/2021
        Set oRangeTo = oSheetTo.Range("A" & CStr(i + 2))
        oRangeTo.Value = aArticlesRuptures(0, i)
        Set oRangeTo = oSheetTo.Range("B" & CStr(i + 2))
        oRangeTo.Value = aArticlesRuptures(1, i)
    Next

    'On fait le ménage
    Set oCell = Nothing
    Set oRangeTo = Nothing
    Set oRangeFrom = Nothing
    Set oSheetTo = Nothing
End Sub

Je joins le classeur qui m'a servi pour les tests.

11copie-de-gestion-de-stock2-gvs.zip (1.06 Mo)
Rechercher des sujets similaires à "integrer articles bon commande"