Bonjour!
je suis nouveau sur ce forum et débutant en VBA. j’ai besoin de votre aide.
j’ai créé un fichier pour traiter les factures des fournisseurs et pour ce faire j’ai créer 3 formulaires:
*Saisir facture
*Préparer règlement
*Effectuer règlement
je n’arrive pas à trouver le bon code pour les formulaires « Préparer règlement » et « Effectuer règlement ».
Avec le formulaire « Préparer règlement », j’ai la possibilité de parcourir toutes les factures échues et non échues de chaque fournisseur. Il faudrait que lorsque je clique sur le bouton « Préparer règlement », les informations sélectionnées soient transférées dans la feuille « FACTURES A REGLER ». j’obtiens des erreurs avec mon code. en capture l’image du formulaire « Préparer règlement »
mon code:
Option Explicit
Dim TFact As ListObject '--- tableau des factures (supposé TOUJOURS commencer en A24)
Dim rFAP As Range '--- factures à payer
Dim vTotal As Long
Dim vPartie As Long
Private Sub cbFourni_Change()
Dim sfeuille As String
On Error Resume Next
sfeuille = cbFourni.Text '--- nom de la feuille (tel qu'indiqué dans tableau TFourn)
ThisWorkbook.Worksheets(sfeuille).Select
Set TFact = ThisWorkbook.Worksheets(sfeuille).Range("A24").ListObject
Debug.Print "Feuille: "; sfeuille, "Tableau: "; TFact.Name
Set rFAP = TFact.Range
TFact.AutoFilter.ShowAllData
TFact.Range.AutoFilter Field:=8, Criteria1:="A régler"
'---
Me.lbFact.RowSource = rFAP.Address
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdRegl_Click()
Dim k As Long, rRgl As Range, arr()
ReDim arr(Me.lbFact.ListCount)
Set rRgl = Range("TRgl")
Set rRgl = rRgl.Rows(rRgl.Rows.Count)
'--- données complètes
'--- note les lignes sélectionnées
For k = 1 To Me.lbFact.ListCount - 1
arr(k) = IIf(Me.lbFact.Selected(k), k, 0)
Next k
'--- ajoute les données dans feuille Règlement
For k = 1 To Me.lbFact.ListCount - 1
If arr(k) > 0 Then
Set rRgl = rRgl.Offset(1, 0)
With rRgl
.Cells(1) = Me.cbFourni.Column(1)
.Cells(2) = Me.lbFact.List(k)
.Cells(3) = Format(Me.lbFact.List(k, 1), "yyyy-mm-dd")
.Cells(4) = Me.lbFact.List(k, 3)
.Cells(5) = Me.lbFact.List(k, 4)
' .Cells(6) = Me.lbFact.List(k, 3)
' .Cells(7) = Format(Me.txtCheqDate, "yyyy-mm-dd")
'.Cells(8) = Me.txtnumcheq
'.Cells(9) = Me.cbBanq
'.Cells(10) = "Rglmt " & cbBanq & " n° " & txtnumcheq
'SousTotaux
End With
End If
Next k
'--- supprime les factures payées
For k = 1 To Me.lbFact.ListCount - 1
If arr(k) > 0 Then
Set rRgl = rFAP.Find(Me.lbFact.List(k))
rRgl.EntireRow.Delete
End If
Next k
Set rRgl = Nothing
End Sub
Private Sub lbFact_Change()
'Debug.Print "lbFact_Change"
Dim k As Long, vTot As Single
vTotal = 0
For k = 1 To Me.lbFact.ListCount - 1
If Me.lbFact.Selected(k) Then
vTotal = vTotal + CLng(Me.lbFact.List(k, 3))
Me.txtCheqNbr = vTotal
Me.txtCheqNbr = Format(Me.txtCheqNbr, "currency")
End If
Next k
'LeCheque
End Sub
Private Sub UserForm_Initialize()
Dim sfeuille As String, rFourn As Range
Me.cbFourni.List = Range("TFourn").Value '--- tout le tableau (3 colonnes, dont seule la 1 est affichée)
sfeuille = ActiveSheet.Name
'Set rFourn = Range("TFourn[Feuille]").Find(sfeuille)
'If rFourn Is Nothing Then
'MsgBox "Annulé: pas de feuille avec ce nom dans la tableau des fournisseurs!", vbCritical, "Anomalie"
'cmdClose_Click
' Else
'Me.cbFourni.Text = rFourn.Offset(0, -2)
'End If
End Sub
Avec le formulaire « Effectuer règlement », je suis censé avoir toutes les factures de la feuille « FACTURES A REGLER » qui seront triées par fournisseur avec le combobox; il faudrait que ce dernier s’alimente en fonction du nom des fournisseurs présents dans la liste des factures à régler. Et lorsque je choisis un fournisseur, je dois avoir les informations concernant le libellé « à l’ordre de » le concernant.
Une fois que tous les champs du formulaires sont renseignés, ces nouvelles données doivent être transférer sur la feuille « FACTURES REGLEES ». Dans ladite feuille, il faudrait avoir une ligne qui sera au dessus de chaque groupe de factures réglées avec le nom de la banque, le n° du chèq ainsi que le montant du chèque précédé de la mention « Nom du fournisseur ». J’en ai fait des exemples.
capture du formulaire « Effectuer règlement »
mon code
Option Explicit
Dim vTotal As Long
Dim vPartie As Long
Dim TRgl As ListObject
Dim rFAP As Range
Private Sub cbquitter2_Click()
Unload Me
End Sub
Private Sub cbvalider2_Click()
Dim k As Long, rRgl As Range, arr()
ReDim arr(Me.lbFact2.ListCount)
'--- vérifie données complètes
If Not IsDate(Me.txtCheqDate2) Then
MsgBox "Annulé: date chèque manquante ou incomplète!", , "Annulé"
Me.txtCheqDate2.SetFocus
Exit Sub '--- EXIT SUB
End If
If Me.cbBanq2 = "" Then
MsgBox "Annulé: banque manquante!", , "Annulé"
Me.cbBanq2.SetFocus
Exit Sub '--- EXIT SUB
End If
If Me.txtnumcheq2 = "" Then
MsgBox "Annulé: n° chèque manquant!", , "Annulé"
Me.txtnumcheq2.SetFocus
Exit Sub '--- EXIT SUB
End If
'--- note les lignes sélectionnées
For k = 1 To Me.lbFact2.ListCount - 1
arr(k) = IIf(Me.lbFact2.Selected(k), k, 0)
Next k
'====== version A: ajoute les données dans feuille "Réglé"
Set rRgl = Range("TRgl")
Set rRgl = rRgl.Rows(rRgl.Rows.Count)
For k = 1 To Me.lbFact2.ListCount - 1
If arr(k) > 0 Then
If IsEmpty(rRgl.Cells(1, 1)) Then
'--- tableau vide, ne rien faire, rester sur la ligne
Else
'--- tableau non vide, passer à la ligne suivante
Set rRgl = rRgl.Offset(1, 0)
End If
With rRgl
.Cells(1) = Me.cbFourni2.Value '--- nom fournisseur
.Cells(2) = Me.lbFact2.List(k) '--- n° facture
.Cells(3) = Format(Me.lbFact2.List(k, 1), "yyyy-mm-dd") '--- date facture
.Cells(4) = Me.lbFact2.List(k, 3) '--- montant TTC
.Cells(5) = Format(Me.lbFact2.List(k, 4), "yyyy-mm-dd") '--- date d'échéance
.Cells(6) = Me.cbBanq2 '--- banque
.Cells(7) = Me.txtnumcheq2 '--- chèque n°
.Cells(8) = Format(Me.txtCheqDate2, "yyyy-mm-dd") '--- chèque date
.Cells(9) = CSng(Val(Replace(Me.txtCheqNbr2, ".", ""))) '--- montant chèque
End With
End If
Next k
'====== fin version A
End Sub
Private Sub lbFact2_Change()
Dim k As Long, vTot As Single
vTotal = 0
For k = 1 To Me.lbFact2.ListCount - 1
If Me.lbFact2.Selected(k) Then
vTotal = vTotal + CLng(Me.lbFact2.List(k, 3))
End If
Next k
LeCheque
End Sub
Private Sub LeCheque()
Me.txtCheqNbr2 = FormatNumber(vTotal, 0) & " F CFA"
Me.txtCheqLettres2 = NombreEnLettres(CDbl(vTotal), "virgule", 0, "F CFA")
Me.txtCheqOrdreDe2 = cbFourni2.Value
End Sub
Private Sub UserForm_Click()
End Sub
J'attends vos suggestions et votre aide avec joie et impatience.
Merci
[Suivi_fournisseur 03.xlsm|attachment](upload://2thXH9GhzGgiDmHrQ60beWeQu7G.xlsm) (240,6 Ko)