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

Manu Manu

XLDnaute Nouveau
Chers tous bonsoir ,
Dans une routine vba Excel, je souhaiterais générer automatique ment dans la textbox le solde du compte une fois les débit et crédit renseignes. Mon souci majeur c'est de pouvoir mettre a jour le solde dans la textbox avant que les données ne soient transférer dans la feuille Excel ci jointe.
Merci d'avance et bon weekend
 

Pièces jointes

  • FormSaisiebrouillard.xlsm
    24.8 KB · Affichages: 29

soan

XLDnaute Barbatruc
Inactif
Bonjour Emmanuel,

je ne suis pas aussi Expert que tu le dis : il y a beaucoup de choses que je ne connais pas ; et je n'ai pas voulu faire de cours de morale ; j'ai seulement voulu éviter que les lecteurs de la conversation zappent le fichier de mon post #12 à cause du smiley triste ; les lecteurs ne pouvaient pas deviner, ni moi non plus, que tu avais mis ce smiley par erreur car tu étais fatigué (ce qui peut arriver à tout l'monde) ; merci pour avoir enlevé le smiley triste, ça me fait vraiment plaisir que tu aies corrigé : mon fichier ne sera plus zappé à tort. :)

pour moi, ça signifie aussi que ce que j'ai fait pour l'ajout d'une opération, dont l'affichage du solde lors de la saisie est OK ➯ le présent sujet est résolu, à propos du bouton "Valider l'opération" ; j'aurais préféré que tu le confirmes toi-même, mébon, on va dire que c'est OK. (d'ailleurs, si ça n'était pas le cas, je pense que tu m'aurais écrit pour indiquer ce qui ne marche pas, n'est-ce pas ? 😜)



pour le bouton "Modifier", ma solution était déjà prête il y a 10 jours, le 9 avril ; c'est un très gros morceau, alors je préfère que tu crées un autre sujet pour cela ; et pour ça seulement, pas aussi pour le bouton "Supprimer la ligne" car ce sera aussi un autre gros morceau.

tu pourras joindre dans ton nouveau sujet le fichier de mon post #12 ; même si tu joins un autre fichier, je posterai ma solution telle qu'elle était déjà prête le 9 avril, sans y faire aucun changement.

je suis tout prêt à continuer à t'aider : je posterai ma solution dès que tu auras ouvert un autre sujet ; il y a un seul inconvénient : je ne veux pas mettre mon fichier comme ça, sans un mode d'emploi pour décrire l'utilisation, et ça va être très long à écrire, car y'a plusieurs choses.​

A plus sur ton autre nouveau sujet. :)

soan
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour,

Image.jpg


Manu Manu est revenu le 27 Avril ; je suppose qu'il a lu mon post #16 précédent, mais il n'a pas daigné créer de nouveau sujet, bien que je lui avais pourtant recommandé de le faire ; aussi, je mets dans ce sujet ma solution pour le bouton "Modifier", mais sans mettre aucune explication : ce sera à lui de faire tous les tests nécessaires et de comprendre mon code VBA. (mais il s'est très probablement désintéressé de ce sujet)



code VBA du UserForm "F_CaisseReunion" :

VB:
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

soan
 

Pièces jointes

  • Test modification data listbox v2.xlsm
    78.3 KB · Affichages: 9
Dernière édition:

Discussions similaires