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 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
| '--------------------------------------------------------------------------------------------------------
Private Sub Form_Load()
Afficher
TextEntrer.Height = MSHFlexGrid1.RowHeight(1) - 15
TextEntrer.FontSize = 10: TextEntrer.FontName = "calibri"
TextEntrer.BackColor = &HC0FFC0
Dim T As Integer
MSHFlexGrid1.Width = 390
For T = 0 To MSHFlexGrid1.Cols - 1
MSHFlexGrid1.Width = MSHFlexGrid1.Width + MSHFlexGrid1.ColWidth(T)
Next T
MSHFlexGrid1.ScrollTrack = True
MSHFlexGrid1.Height = 8130
MSHFlexGrid1.Left = 30: MSHFlexGrid1.Top = 30
FrmSolde.Width = MSHFlexGrid1.Width + (MSHFlexGrid1.Left * 2) + 360
FrmSolde.Height = MSHFlexGrid1.Height + (MSHFlexGrid1.Top * 2) + 690
End Sub
'--------------------------------------------------------------------------------------------------------
Private Sub MSHFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'pour être sur que la boite entrées du texte ne soit pas visible
TextEntrer.Left = -TextEntrer.Width
If MSHFlexGrid1.MouseRow = 0 Then Exit Sub
'memorisation index colonne et index ligne de la cellule cliqué
MSHFlexGrid1.Tag = MSHFlexGrid1.MouseRow & "," & MSHFlexGrid1.MouseCol
'pour definir le Left de la boite entrées du texte
LeftText = (MSHFlexGrid1.CellLeft + MSHFlexGrid1.Left) '- 15
'pour ajuster le width de la boite entrées du texte
WidthText = MSHFlexGrid1.CellWidth
'pour definir le Top de la boite entrées du texte
TopText = (MSHFlexGrid1.CellTop + MSHFlexGrid1.Top) '- 15
'pour remplir la boite entrées du texte avec le texte de la cellule active
TextEntrer.Text = MSHFlexGrid1.Text
'deplacement et recouvrement
'de la cellule active par la boite entrées du texte
TextEntrer.Move LeftText, TopText, WidthText
Select Case MSHFlexGrid1.MouseCol
Case 1 To 6, 8
'donne le focus à la boite entrées du texte
TextEntrer.SetFocus
Case Else
TextEntrer.Left = -TextEntrer.Width
End Select
End Sub
'--------------------------------------------------------------------------------------------------------
Private Sub MSHFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'pour être sur que la boite entrées du texte ne soit pas visible
TextEntrer.Left = -TextEntrer.Width
End Sub
'--------------------------------------------------------------------------------------------------------
Private Sub MSHFlexGrid1_Scroll()
'pour être sur que la boite entrées du texte ne soit pas visible
'durant le defilement des lignes
TextEntrer.Left = -TextEntrer.Width
End Sub
'--------------------------------------------------------------------------------------------------------
Private Sub TextEntrer_KeyPress(KeyAscii As Integer)
'gestion pour la modification d'une cellule texte du grid
If KeyAscii = 27 Then 'abandon
TextEntrer.Left = -TextEntrer.Width: Exit Sub
End If
Dim Idxs() As String
Dim NumLgn As Integer, NumCol As Integer
If KeyAscii = 13 Then 'validation de la modification
TextEntrer.Left = -TextEntrer.Width
Idxs = Split(MSHFlexGrid1.Tag, ",")
NumLgn = CInt(Idxs(0)) 'recuperatioin du N° de ligne
NumCol = CInt(Idxs(1)) 'recuperatioin du N° de ligne
Dim DataEntrer As Variant
KeyAscii = 0
DataEntrer = Trim(TextEntrer.Text)
Select Case NumCol
Case 1 'date
If Not IsDate(DataEntrer) Then
MsgBox "Entrez une date valide"
Exit Sub
End If
MSHFlexGrid1.Text = DataEntrer
'enregistrer juste le champ modifié dans la BDs
'A FAIRE
Enregistre_Champs NumLgn, NumCol
Case 5, 6
'VB calcul avec le separateur decimal ,(virgule) donc transforme léventuel point en virgule
DataEntrer = Replace(TextEntrer.Text, ".", ",")
If DataEntrer = "" Then DataEntrer = 0
If Not IsNumeric(DataEntrer) Then
MsgBox "Entrez un chiffre"
Exit Sub
End If
'actualise la cellule modofiée
MSHFlexGrid1.Text = Replace(DataEntrer, ",", ".")
Calcul_Solde NumLgn ' cela a semble OK
'maintenant on actualise la BD
actualiseBDs NumLgn, MSHFlexGrid1.Rows
Case 2 To 4, 8
MSHFlexGrid1.Text = DataEntrer
'enregistrer juste le champ modifié dans la BDs
'A FAIRE
Enregistre_Champs NumLgn, NumCol
End Select
End If
End Sub
Sub Enregistre_Champs(NumLgn As Integer, NumCol As Integer)
Dim NomChamps As String
Call ConnectDB
Select Case NumCol
Case 1: NomChamps = "DJour"
Case 2: NomChamps = "Categorie"
Case 3: NomChamps = "SCategorie"
Case 4: NomChamps = "Detail"
Case 8: NomChamps = "Financier"
End Select
Set RsR = New ADODB.Recordset
SQLR = "Select " & NomChamps & " From Depenses where Num = " & NumLgn 'car Num est la clé de la base
RsR.Open SQLR, Cnx, adOpenStatic, adLockOptimistic, adCmdText
RsR.MoveFirst
RsR.Fields(NomChamps) = MSHFlexGrid1.TextMatrix(NumLgn, NumCol)
RsR.Update
DoEvents
RsR.Close: Set RsR = Nothing
Cnx.Close: Set Cnx = Nothing
End Sub
'---------------------------------------------------------------------------------------------------------
Sub actualiseBDs(NumLgn As Integer, NbrLgn As Integer)
Dim T As Integer, SQLR As String
Call ConnectDB
Set RsR = New ADODB.Recordset
SQLR = "Select * From Depenses where Num >= " & NumLgn & " Order by Num" 'car Num est la clé de la base
RsR.Open SQLR, Cnx, adOpenStatic, adLockOptimistic, adCmdText
RsR.MoveFirst
For T = NumLgn To NbrLgn - 1
RsR.Fields("DJour") = MSHFlexGrid1.TextMatrix(T, 1)
RsR.Fields("Categorie") = MSHFlexGrid1.TextMatrix(T, 2)
RsR.Fields("SCategorie") = MSHFlexGrid1.TextMatrix(T, 3)
RsR.Fields("Detail") = MSHFlexGrid1.TextMatrix(T, 4)
RsR.Fields("Debit") = MSHFlexGrid1.TextMatrix(T, 5)
RsR.Fields("Credit") = MSHFlexGrid1.TextMatrix(T, 6)
RsR.Fields("Solde") = MSHFlexGrid1.TextMatrix(T, 7)
RsR.Fields("Financier") = MSHFlexGrid1.TextMatrix(T, 8)
RsR.Update
DoEvents
If T <> NbrLgn - 1 Then RsR.MoveNext
Next T
RsR.Close: Set RsR = Nothing
Cnx.Close: Set Cnx = Nothing
End Sub
'---------------------------------------------------------------------------------------------------------
Sub Calcul_Solde(LgnEnCour As Integer)
Dim i As Integer
'Dim solde As Long
'colonne 5=Debit , 6=Credit, 7=Solde
Dim sommedebit As Single, sommecredit As Single, PrecedentSolde As Single, solde
For i = LgnEnCour To MSHFlexGrid1.Rows - 1
sommedebit = CSng(Replace(MSHFlexGrid1.TextMatrix(i, 5), ".", ","))
sommecredit = CSng(Replace(MSHFlexGrid1.TextMatrix(i, 6), ".", ","))
If i = 1 Then
'solde de la première ligne ou solde initiale = debit-credit
solde = sommedebit - sommecredit
Else
'Nouveau solde = solde précedent+(debit-credit)
PrecedentSolde = CSng(Replace(MSHFlexGrid1.TextMatrix(i - 1, 7), ".", ","))
solde = PrecedentSolde + (sommedebit - sommecredit)
End If
MSHFlexGrid1.TextMatrix(i, 7) = Replace(solde, ",", ".")
Next i
End Sub
'----------------------------------------------------------------------------------------------------------------------------------
Sub Afficher()
'On Error Resume Next
Call ConnectDB
Set RsR = New ADODB.Recordset
SQLR = "Select * From Depenses Order by Num" 'car Num est la clé de la base
RsR.Open SQLR, Cnx, adOpenStatic, adLockOptimistic, adCmdText
RsR.MoveFirst
'TBox(15) = "0" & RcR.RecordCount
With MSHFlexGrid1
.RowHeight(0) = 400
.Clear
.Refresh
.Rows = RsR.RecordCount + 1
.Cols = RsR.Fields.Count
.FixedCols = 0
.FixedRows = 1
.Row = 1
.Col = 0
.RowSel = .Rows - 1
.ColSel = .Cols - 1
.Clip = RsR.GetString(adClipString, -1, Chr(9), Chr(13), vbNullString)
.RowSel = 1
.ColSel = 0
.Visible = True
.ColWidth(0) = 500: .TextMatrix(0, 0) = "Num"
.ColWidth(1) = 1200: .TextMatrix(0, 1) = "DateJour"
.ColWidth(2) = 1500: .TextMatrix(0, 2) = "Catégorie"
.ColWidth(3) = 2100: .TextMatrix(0, 3) = "Sous Catégorie"
.ColWidth(4) = 5200: .TextMatrix(0, 4) = "Détail Recette & Dépense"
.ColWidth(5) = 1200: .TextMatrix(0, 5) = "Débit"
.ColWidth(6) = 1200: .TextMatrix(0, 6) = "Crédit"
.ColWidth(7) = 1200: .TextMatrix(0, 7) = "Solde"
.ColWidth(8) = 900: .TextMatrix(0, 8) = "Financier"
.ColAlignment(5) = flexAlignRightCenter
.ColAlignment(6) = flexAlignRightCenter
.ColAlignment(7) = flexAlignRightCenter
.ColAlignment(8) = flexAlignCenterCenter
End With
While Not MSHFlexGrid1.RowIsVisible(MSHFlexGrid1.Rows - 1)
MSHFlexGrid1.TopRow = MSHFlexGrid1.TopRow + 2
Wend
RsR.Close
Set RsR = Nothing
Calcul_Solde 1 ' -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- ligne a modifier *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
End Sub |
Partager