Discussion :

[Angeoffi]

Bonjour à tous!

je suis sur la conception d'un gestionnaire qui doit gérer mes achats , mon stock et ma caisse

l'idée est que lorsque je fais un achat , les infos d'articles (fournisseurs, catégories d'articles , la désignation, le Prix unitaire,....) sont transférées dans un panier: ici un listview

au click sur le bouton enregistrer les différentes infos sont transférer dans les feuilles achat, mouvements de stocks et caisse.

voila j'ai un soucis

1. au click sur le bouton enregistrer, les infos dans les feuilles achat et en caisse sont passées correctement.
cependant au niveau des mouvements de stocks, la macro saute une ligne entre les différents articles

voic mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim ws As Worksheet, wsR As Worksheet, wsG As Worksheet
Dim L As Long, Cl As Long, i As Long, j As Long, Lr As Long, lrR As Long, LrG As Long
Dim Tbl() As Variant
 
Set ws = Sheets("Achat")
Set wsR = Sheets("Caisse")
Set wsG = Sheets("Mouvements Stocks")
 
 
'copie listview vers feuille achat
With Me.ListVAppro
    'mise en memoire de la listview
    L = .ListItems.Count
    Cl = .ColumnHeaders.Count
    ReDim Tbl(1 To L + 1, 1 To Cl)
    For i = 1 To L
        Tbl(i, 1) = .ListItems(i).Text
        For j = 1 To Cl - 1
            Tbl(i, j + 1) = .ListItems(i).ListSubItems(j).Text
        Next j
    Next i
 
    If .ListItems.Count < 1 Then
        MsgBox " Ajouter des produits a la facture!", vbCritical + vbOKOnly, ""
        Exit Sub
    Else
        If Me.TextLibelle = "" Then
        MsgBox " Veuillez Saisir un libelle", vbCritical, ""
        Me.TextLibelle.SetFocus
        Exit Sub
        End If
 
        If MsgBox("Voulez - vous enregistrer cette facture?", vbYesNo, "Demande de confirmation") = vbYes Then
 
            With ws
                Lr = .Range("B" & Rows.Count).End(xlUp).Row 'derniere ligne ocuppe sur la ligne b
                For i = 1 To L ' boucle sur les lignes du tableau
 
                    .Range("c" & Lr + i) = Tbl(i, 1) ' Articles
                    .Range("D" & Lr + i) = Tbl(i, 2) ' Qte
                    .Range("e" & Lr + i) = Tbl(i, 3) ' PU
                    .Range("f" & Lr + i) = Tbl(i, 4) ' Remise
                    .Range("g" & Lr + i) = Tbl(i, 5) ' Montant
                    .Range("b" & Lr + i) = CDate(Me.TextDate) ' Date
                    .Range("b" & Lr + i) = Format(CDate(.Range("b" & Lr + i)), "DD-MM-YYYY")
                    .Range("h" & Lr + i) = Me.ComboFrs ' fournisseurs
                    .Range("i" & Lr + i) = Me.TextCodeFact ' code facture
                    .Range("j" & Lr + i) = Me.TextNumFact ' Numero Facture
 
                Next i
            End With
 
              With wsG
 
              For i = 1 To L
              LrG = wsG.Range("b" & Rows.Count).End(xlUp).Row
 
                    'enregistrement des données de stock
                    .Range("A" & LrG + i) = Me.TextDate   'date
                    .Range("b" & LrG + i) = "Entree"   'operation
                    .Range("c" & LrG + i) = Me.ComboFrs   'Tiers
                    .Range("d" & LrG + i) = Me.TextCodeFact   'N° piece
                    .Range("e" & LrG + i) = Me.TextNumFact  'N° facture
                    .Range("g" & LrG + i) = Me.ComboArticles   ' Categorie articles
                    .Range("h" & LrG + i) = Tbl(i, 1)   'designation
                    .Range("i" & LrG + i) = Me.TextLibelle   ' libelle
                    .Range("j" & LrG + i) = Tbl(i, 2)   'qte
                    .Range("k" & LrG + i) = Tbl(i, 3)   ' PU
                    .Range("l" & LrG + i) = Tbl(i, 5)  ' Montant
            Next i
            End With
 
    ' enregistrement des infos de reglement en caisse
 
        If Me.TextMontantPay = "" Then Exit Sub
 
        lrR = wsR.Range("B" & Rows.Count).End(xlUp).Row + 1
 
        wsR.Range("B" & lrR) = Me.TextDate ' Date
        wsR.Range("C" & lrR) = "Decaissement" ' operations
        wsR.Range("d" & lrR) = "Achat Boissons" 'Poste budgetaire
        wsR.Range("e" & lrR) = Me.ComboFrs ' Tiers
        wsR.Range("f" & lrR) = Me.TextCodeFact ' numero facture
        wsR.Range("g" & lrR) = Me.TextLibelle ' libelle
        wsR.Range("i" & lrR) = CLng(Me.TextMontantPay) 'Montant paye
        wsR.Range("i" & lrR) = CLng(wsR.Range("i" & lrR))
        End If
End If
 
Unload Me
NumeroFacture
FrmAppro.Show
 
Set ws = Nothing
Set wsR = Nothing
Set wsR = Nothing
End With
 
End Sub

merci pour vos différents apports

PS: le fichier test

cordialement

[Franc]

Salut, c'est parce que dans cette partie de code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
              With wsG
 
              For i = 1 To L
                 LrG = wsG.Range("A" & Rows.Count).End(xlUp).Row
                .Range("A" & LrG + i) = Me.TextDate

tu cherches la dernière ligne à chaque itération de la boucle et donc LrG est d'abord incrémenté de 1, puis 2, etc... Tu dois sortir LrG de la boucle.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
              With wsG
              LrG = wsG.Range("A" & Rows.Count).End(xlUp).Row
 
              For i = 1 To L
                    .Range("A" & LrG + i) = Me.TextDate

[Angeoffi]

Merci franc pour ta réponse

je me suis arracher les cheveux de la tete.

merci encore

je voudrais profiter pour soumettre un autre soucis.

il se situe au niveau du code facture.

Au clic d bouton enregistrer , le userform est fermé et s'ouvre.

je veux que lorsqu'il s'ouvre de nouveau le code de la facture s'incrémente.

j'ai essayé cette macro que j'ai intégré dans le code du bouton enregistrer mais elle ne fonctionne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub NumeroFacture()
 
Dim Numero As String
Dim MoisEncours
Dim AnneeEncours
Dim DateEncours
Dim i As Integer
 
Numero = Me.TextCodeFact.Value
 
MoisEncours = Format(Date, "MM")
AnneeEncours = Format(Date, "YY")
DateEncours = "FA" & MoisEncours & AnneeEncours
 
If Mid(Numero, 7, 2) = AnneeEncours Then
    Me.TextCodeFact = DateEncours & Format(Int(Right(Numero, 4)) + 1, "0000")
Else
   Me.TextCodeFact = DateEncours & "0001"
 
End If
End Sub

merci d'avance

[Franc]

Salut, teste comme ceci. Je fais la recherche sur la colonne "Code Appro" de la feuille "Achat" pour vérifier si le code facture existe et si c'est le cas alors incrément de 1.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub NumeroFacture()
 
    Dim ws As Worksheet
    Dim cell As Range
    Dim Numero As String
    Dim MoisEncours As String
    Dim AnneeEncours As String
    Dim DateEncours As String
    Dim DernierNumero As Long
    Dim TempNumero As Long
 
    Set ws = ThisWorkbook.Sheets("Achat")
    MoisEncours = Format(Date, "MM")
    AnneeEncours = Format(Date, "YY")
    DateEncours = "FA" & MoisEncours & AnneeEncours
    DernierNumero = 0
 
    ' Parcours de la colonne I
    For Each cell In ws.Range("I2:I" & ws.Cells(ws.Rows.Count, "I").End(xlUp).Row)
        If Left(cell.Value, 6) = DateEncours Then
            On Error Resume Next
            TempNumero = CLng(Right(cell.Value, 4))
            On Error GoTo 0
            If TempNumero > DernierNumero Then
                DernierNumero = TempNumero
            End If
        End If
    Next cell
 
    ' Nouveau numéro incrémenté
    Me.TextCodeFact.Value = DateEncours & Format(DernierNumero + 1, "0000")
 
End Sub

[Angeoffi]

encore une fois Merci Franc

j'ai tester le code et ça marche parfaitement.

Merci encore

je ne voudrais trop t'importuner mais , toujours des incohérences dans mon code.

là je récupère le Prix unitaire par code au choix d'une désignation.

mais lorsque je saisi manuellement dans le textbox Prix unitaire , le Montant pour la désignation ( textbox Total) ne change pas.

Pourrais tu me donner un coup de pouce.

cordialement

[Franc]

Salut, j'ai ajouté une ligne à ta macro d'origine et supprimé tous les Me. qui ne sont pas nécessaires.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub TextPU_change()
 
    If TextPU = "" Then Exit Sub
    If IsNumeric(TextPU) = False Then
        MsgBox "Veuillez saisir un Nombre!", vbCritical, ""
        TextPU.SetFocus
        Exit Sub
    Else
        TextPU = Format(TextPU, "# ##0")
        TextTotal.Value = CStr(Val(TextQte.Value) * Val(TextPU.Value))
    End If
 
End Sub