XL 2013 Code VBA Excel de calcul du solde journal et affectation résultat dans la colonne solde

Option Explicit

Const fmt As String * 8 = "#,##0.00"
Dim Solde@, Debit@, Credit@, errS As Byte

Private Sub txtJour_AfterUpdate()
  On Error Resume Next
  If IsDate(txtJour) Then txtJour = Format(txtJour, "DD/MM/YYYY") _
    Else MsgBox "Veuillez saisir une date valide Svp", vbCritical
End Sub

Private Sub txtJour_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  If KeyAscii = 27 Then Unload Me
End Sub

Private Function ValNb(Nb$) As Currency
  ValNb = Val(Replace$(Replace$(Nb, Chr$(160), ""), ",", "."))
End Function

Private Function SC() As Currency 'Solde Caisse (en colonne I)
  Dim Op&, OldD@, OldC@, k&, n&: Op = Val(txtNumeroOpe)
  If Op = 0 Then n = Cells(Rows.Count, 9).End(3).Row Else n = Op + 1
  If n = 1 Then Solde = 0 Else Solde = Cells(n, 9)
  If Op > 0 Then
    With ListBoxCaisse
      k = .ListIndex: OldD = .List(k, 6): OldC = .List(k, 7)
      Solde = Solde + OldC - OldD 'solde AVANT le mouvement
    End With
  End If
  SC = Solde
End Function

Sub ShowSolde(typ%)
  If typ <> -1 Then
    Solde = SC()
    If typ = 1 Then Solde = Solde + Debit
    If typ = 2 Then Solde = Solde - Credit
  End If
  lblSolde = Format(Solde, fmt)
  'Sens du solde ; compte caisse => solde créditeur impossible !!! on va refuser
  'toute sortie supérieure au solde !!! donc au pire, le solde sera nul !!!
  SensSolde = "Solde " & IIf(Solde = 0, "nul", "débiteur")
End Sub

Private Sub cbo_Transaction_Change()
  Dim b As Boolean: txtEntree = "": txtSortie = "": lblSolde = Format(SC, fmt)
  b = cbo_Transaction = "Recette": txtEntree.Enabled = b: txtSortie.Enabled = Not b
End Sub

Private Sub cbo_Transaction_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  If cbo_Transaction = "" Then Cancel = True
End Sub

Private Sub txtEntree_AfterUpdate()
  Debit = ValNb(txtEntree): If Debit <= 0 Then errS = 1: Exit Sub
  errS = 0: txtEntree = Format(Debit, fmt): ShowSolde 1
End Sub

Private Sub txtEntree_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  If errS = 0 Then Exit Sub
  MsgBox "Veuillez saisir un montant d'entrée valide Svp", 16
  txtEntree = "": Cancel = -1
End Sub

Private Sub txtSortie_AfterUpdate()
  Credit = ValNb(txtSortie): If Credit <= 0 Then errS = 1: Exit Sub
  If Credit > SC Then errS = 2: Exit Sub 'attention : comme c'est un
  'compte Caisse, on ne peut pas retirer plus que le dernier solde !
  errS = 0: txtSortie = Format(Credit, fmt): ShowSolde 2
End Sub

Private Sub txtSortie_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  If errS = 0 Then Exit Sub
  Dim msg$
  msg = IIf(errS = 1, "Veuillez saisir un montant de sortie valide Svp", _
    "Vous ne pouvez pas retirer plus que " & Format(SC, fmt) & " € !")
  MsgBox msg, 16: txtSortie = "": Cancel = -1
End Sub

'=============================PROCEDURE D'AFFICHAGE DES DONNEES DANS LA LISTBOX DE CAISSE=======================
'Procedure a appeler au chargement du formulaire de caisse pour qu'elle s'execute
Sub AlimenterLBcaisse()
  Dim n&: n = Cells(Rows.Count, 2).End(3).Row: If n = 1 Then Exit Sub
  With ListBoxCaisse
    .ColumnHeads = True: .ColumnCount = 11
    .ColumnWidths = "30;50;50;120;80;135;55;55;60;60;65"
    .RowSource = "BDcaisse!A2:K" & n
  End With
End Sub

Private Sub CmdValiderT_Click() 'AJOUTER UNE OPERATION DANS LE JOURNAL DE CAISSE
  'Contrôle des valeurs saisies=================================================
  Dim msg$, k As Byte
  If txtJour = "" Then msg = "la date de l'opération": k = 1
  If k = 0 And cbo_Transaction = "" Then msg = "le type de transaction dans la liste": k = 2
  If k = 0 And cbo_NomAdherent = "" Then msg = "un adhérent dans la liste": k = 2
  If k = 0 And cbo_Rubrique = "" Then msg = "une rubrique dans la liste": k = 2
  If k = 0 And txtLibelle = "" Then msg = "le libellé de l'opération": k = 1
  If k > 0 Then MsgBox "Veuillez " _
    & IIf(k = 1, "saisir ", "sélectionner ") & msg & " Svp !", 16: Exit Sub
  Debit = ValNb(txtEntree): Credit = ValNb(txtSortie)
  If Debit = 0 And Credit = 0 Then _
    MsgBox "Tous les montants ne peuvent être nuls !", 16: Exit Sub
  'Validation des données saisies===============================================
  If MsgBox("Confirmez-vous l'ajout de cette " & cbo_Transaction & " dans le journal ? ", _
    vbQuestion + vbYesNo, "Validation ") <> vbYes Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 2).End(3).Row + 1: NbTransac = n - 1
  With Cells(n, 1)
    .Value = "=Row()-1": .Offset(, 1) = txtJour: .Offset(, 2) = cbo_Transaction
    .Offset(, 3) = cbo_NomAdherent: .Offset(, 4) = cbo_Rubrique: .Offset(, 5) = txtLibelle
    If Debit > 0 Then .Offset(, 6) = Debit Else .Offset(, 7) = Credit 'Débit OU Crédit
    .Offset(, 8) = ValNb(lblSolde): .Offset(, 9) = SensSolde: .Offset(, 10) = Now
  End With
  'Remise à zéro des txtbox=====================================================
  txtJour = "": cbo_Transaction = "": cbo_NomAdherent = "": cbo_Rubrique = ""
  txtLibelle = "": txtEntree = "": txtSortie = "": lblSolde = "": SensSolde = ""
  AlimenterLBcaisse 'Alimentation de la listbox avec les data de la feuille
  With Range("A2:K" & n) 'Mise en forme des cellules du tableau
    .BorderAround LineStyle:=xlDouble
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Font.Bold = 0: .Font.Size = 11
  End With
  MsgBox "L'opération saisie a été ajoutée avec succès dans votre journal !"
  txtJour.SetFocus
End Sub

Private Sub CmdModifierT_Click() 'MODIFIER UNE OPERATION DU JOURNAL DE CAISSE
  'Vérif si une opération a bien été sélectionnée (par double-clic) ; si oui : cette
  'opération est présente dans le masque de saisie, et son n° est dans txtNumeroOpe.
  Dim msg$, k As Byte, Op&
  Op = Val(txtNumeroOpe): If Op = 0 Then msg = "les données à mettre à jour": k = 2
  'Contrôle des vides des txtbox ===================================================
  If k = 0 And txtJour = "" Then MsgBox "la date du jour": k = 1
  If k = 0 And cbo_Transaction = "" Then msg = "le type de transaction": k = 2
  If k = 0 And cbo_NomAdherent = "" Then msg = "le nom de l'adhérent": k = 2
  If k = 0 And cbo_Rubrique = "" Then msg = "la rubrique de cette opération": k = 2
  If k = 0 And txtLibelle = "" Then msg = "le libellé de cette opération": k = 1
  If k = 0 Then
    Debit = ValNb(txtEntree): Credit = ValNb(txtSortie)
    If Debit = 0 And Credit = 0 Then _
      msg = "le montant de l'entrée ou sortie de cette opération": k = 1
  End If
  If k > 0 Then MsgBox "Veuillez " _
    & IIf(k = 1, "saisir ", "sélectionner ") & msg & " Svp !", 16: Exit Sub
  '=================================================================================
' If MsgBox("Souhaitez-vous enregistrer la modification de l'opération numéro " _
'   & txtNumeroOpe & " ?", 36, "Confirmation de modification ") <> 6 Then Exit Sub
  Dim T, S@, d&, n&, i&
  d = Cells(Rows.Count, 9).End(3).Row - Op
  If d > 1 Then
    n = Op + 1: T = Cells(n, 7).Resize(d, 4): S = Solde: T(1, 3) = S
    For i = 2 To d
      S = S + T(i, 1) - T(i, 2): T(i, 3) = S
      If S < 0 Then
        msg = "Modif REFUSÉE car ça entraîne un solde CRÉDITEUR" & vbLf & "en AVAL " _
          & "de la ligne en cours !!!" & vbLf & vbLf & "Opération n° " & i + n - 2 _
          & " => SC = " & Format(S, fmt)
        MsgBox msg, 16: Exit Sub
      End If
      T(i, 4) = "Solde " & IIf(S > 0, "débiteur", "nul")
    Next i
  End If
  Debit = ValNb(txtEntree): Credit = ValNb(txtSortie)
  If Debit > 0 Then T(1, 1) = Debit: T(1, 2) = Empty
  If Credit > 0 Then T(1, 1) = Empty: T(1, 2) = Credit
  Cells(n, 7).Resize(d, 4) = T
  With Cells(n, 3)
    .Value = cbo_Transaction: .Offset(, 1) = cbo_NomAdherent: .Offset(, 2) = cbo_Rubrique
    .Offset(, 3) = txtLibelle: .Offset(, 8) = Now
  End With
  txtJour = "": cbo_Transaction = "": cbo_NomAdherent = "": cbo_Rubrique = ""
  txtLibelle = "": txtEntree = "": txtSortie = "": txtNumeroOpe = ""
  ShowSolde 0: SensSolde = "Solde " & IIf(Solde > 0, "débiteur", "nul")
' MsgBox "Les modifications des références de l'adhérent sélectionné ont été enregistrées !"
End Sub

Private Sub CmdSupprimerT_Click()
  '=================SUPPRESSION DES DONNEES DE LA BD================================
  '============Reprendre les declarations faites au bouton update et la reprise de la routine de transfert des data=================
  If txtNumeroOpe = "" Then _
    MsgBox "Veuillez sélectionner les données à mettre à jour Svp!": Exit Sub
  '===========reprise de la routine de transfert de data dans la feuille=================
  Dim Selected_Row&                                'remplacer derligne par Selected_Row
  Selected_Row = Application.WorksheetFunction.Match(CLng(txtNumeroOpe), Columns(1), 0)
  If MsgBox("Confirmez-vous la suppression de la transaction de " & cbo_NomAdherent _
    & " dans le journal caisse?", 36, "Confirmation de suppression ") <> 6 Then Exit Sub
  'ajouter l'instruction de suppression de la ligne selectionnee
  Range("A" & Selected_Row).EntireRow.Delete
  'reinitialiser les txbox apres la suppression en copiant la raz du bouton 2
  txtJour = "": cbo_Transaction = "": cbo_NomAdherent = "": cbo_Rubrique = ""
  txtLibelle = "": txtEntree = "": txtSortie = "": lblSolde = ""
  SensSolde = "": txtNumeroOpe = ""
  'Apres la suppression, mettre a jour les data dans la feuille et donc la lb en appelant la procedure de mise a jour de la lb
  Call AlimenterLBcaisse ': ShowSolde 0
  MsgBox "La transaction de  " & cbo_NomAdherent & _
    " a été définitivement supprimée dans le journal! "
End Sub

Private Sub CmdSaveCaisse_Click()
  ThisWorkbook.Save: MsgBox "Vos données ont été enregistrées  avec succès!", vbInformation
End Sub

Private Sub CmdQuitterC_Click()
  Unload Me
End Sub

Private Sub ListBoxCaisse_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim n&
  With ListBoxCaisse
    n = .ListIndex
    txtNumeroOpe = .List(n, 0): txtJour = .List(n, 1): cbo_Transaction = .List(n, 2)
    cbo_NomAdherent = .List(n, 3): cbo_Rubrique = .List(n, 4): txtLibelle = .List(n, 5)
    txtEntree = Format(.List(n, 6), fmt): txtSortie = Format(.List(n, 7), fmt)
    Solde = .List(n, 8): ShowSolde -1: SensSolde = .List(n, 9)
    .TextAlign = fmTextAlignLeft: txtJour = Format(txtJour, "dd/mm/yyyy")
  End With
End Sub

Private Sub UserForm_Initialize()
  cbo_Transaction.List = Array("Recette", "Dépense") 'Type transaction
  'Liste des rubriques
  cbo_Rubrique.List = Array("AGEDEF", "Amendes", "Assurance", "Banque", "Bloqué", _
    "Collation", "Comité", "Divers", "Dons", "Epargne annuelle", "Epargne scolaire", _
    "Fonds de caisse", "Foyer", "Grande tontine", "Inscription", "Interets", _
    "Petite tontine", "Prêt", "Rafraichissement", "Remboursement")
  Dim T, n&
  With Worksheets("BDadherent") 'Nom et prénom(s) adhérent
    n = .Cells(Rows.Count, 2).End(3).Row
    If n > 1 Then n = n - 1: T = .[B2].Resize(n): cbo_NomAdherent.List = T
  End With
  ShowSolde 0: AlimenterLBcaisse: NbTransac = ListBoxCaisse.ListCount
End Sub