تطبيق تسيير وتسجيل الفواتير (الاكسل المحاسبي بالذكاء الاصطناعي)

Private Sub CommandButton1_Click() Dim reponse As VbMsgBoxResult Dim question As String question = ThisWorkbook.Sheets("Langue").Range("E28").Value reponse = MsgBox(question, vbYesNo + vbQuestion, "Confirmation") If reponse = vbNo Then Unload Me Else With ThisWorkbook.Sheets("Etat") .Range("D2").Value = Me.CommandButton1.Caption .Range("D3").Value = Me.ComboBox1.Value ' ?? ????? ????? ??????????? ??? D3 .Range("J4").Value = Me.TextBox1.Value .Range("J5").Value = Me.TextBox2.Value End With Call TransfererDonnees End If End Sub Private Sub CommandButton2_Click() Unload Me UserForm2.Show End Sub Private Sub CommandButton3_Click() Me.Hide UserForm3.Show End Sub Private Sub UserForm_Activate() Me.Label1.Caption = ThisWorkbook.Sheets("Langue").Range("E9").Value Me.Label2.Caption = ThisWorkbook.Sheets("Langue").Range("E10").Value Me.Label3.Caption = ThisWorkbook.Sheets("Langue").Range("E11").Value Me.Label4.Caption = ThisWorkbook.Sheets("Langue").Range("E12").Value Me.CommandButton1.Caption = ThisWorkbook.Sheets("Langue").Range("E13").Value Me.CommandButton2.Caption = ThisWorkbook.Sheets("Langue").Range("E14").Value Me.CommandButton3.Caption = ThisWorkbook.Sheets("Langue").Range("E15").Value End Sub Private Sub UserForm_Initialize() Call RemplirFournisseurs Dim ws As Worksheet Dim rng As Range, cell As Range Dim minDate As Date, maxDate As Date Dim firstDateFound As Boolean Set ws = ThisWorkbook.Sheets("Base") Set rng = ws.Range("E10:E" & ws.Cells(ws.Rows.Count, "E").End(xlUp).Row) firstDateFound = False For Each cell In rng If IsDate(cell.Value) Then If Not firstDateFound Then minDate = cell.Value maxDate = cell.Value firstDateFound = True Else If cell.Value < minDate Then minDate = cell.Value If cell.Value > maxDate Then maxDate = cell.Value End If End If Next cell If firstDateFound Then Me.TextBox1.Value = Format(minDate, "dd/mm/yyyy") Me.TextBox2.Value = Format(maxDate, "dd/mm/yyyy") Else Me.TextBox1.Value = "Aucune date" Me.TextBox2.Value = "Aucune date" End If Me.Width = Application.Width Me.Height = Application.Height With Me .Frame1.Left = (.Width - .Frame1.Width) / 2 .Frame1.Top = (.Height - .Frame1.Height) / 2 End With End Sub Private Sub ComboBox1_Change() Call RemplirClients End Sub Sub RemplirFournisseurs() Dim cell As Range, dict As Object Set dict = CreateObject("Scripting.Dictionary") Me.ComboBox1.Clear Me.ComboBox2.Clear For Each cell In Sheets("Base").Range("B10:B" & Sheets("Base").Cells(Rows.Count, "B").End(xlUp).Row) If Trim(cell.Value) <> "" Then If Not dict.exists(cell.Value) Then dict.Add cell.Value, Nothing Me.ComboBox1.AddItem cell.Value End If End If Next cell End Sub Sub RemplirClients() Dim lastRow As Long, i As Long Dim selectedFournisseur As String Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") selectedFournisseur = Me.ComboBox1.Value Me.ComboBox2.Clear If selectedFournisseur = "" Then Exit Sub With Sheets("Base") lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For i = 10 To lastRow If Trim(.Cells(i, "B").Value) = selectedFournisseur Then If Trim(.Cells(i, "C").Value) <> "" Then If Not dict.exists(.Cells(i, "C").Value) Then dict.Add .Cells(i, "C").Value, Nothing Me.ComboBox2.AddItem .Cells(i, "C").Value End If End If End If Next i End With End Sub Sub TransfererDonnees() Dim wsSource As Worksheet, wsDest As Worksheet Dim lastRowSource As Long, lastUsedRow As Long Dim i As Long, destRow As Long Dim fournisseur As String, client As String Dim matchFournisseur As Boolean, matchClient As Boolean, matchDate As Boolean Dim dateMin As Date, dateMax As Date Dim cellDate As Variant Set wsSource = ThisWorkbook.Sheets("Base") Set wsDest = ThisWorkbook.Sheets("Etat") fournisseur = UserForm1.ComboBox1.Value client = UserForm1.ComboBox2.Value If IsDate(UserForm1.TextBox1.Value) And IsDate(UserForm1.TextBox2.Value) Then dateMin = CDate(UserForm1.TextBox1.Value) dateMax = CDate(UserForm1.TextBox2.Value) Else MsgBox "Les dates saisies ne sont pas valides.", vbExclamation Exit Sub End If With wsDest On Error Resume Next lastUsedRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row On Error GoTo 0 If lastUsedRow >= 10 Then .Rows("10:" & lastUsedRow).ClearContents End If End With lastRowSource = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row destRow = 10 For i = 10 To lastRowSource matchFournisseur = (wsSource.Cells(i, "B").Value = fournisseur) matchClient = (wsSource.Cells(i, "C").Value = client Or client = "") cellDate = wsSource.Cells(i, "E").Value If IsDate(cellDate) Then matchDate = (cellDate >= dateMin And cellDate <= dateMax) Else matchDate = False End If If matchFournisseur And matchClient And matchDate Then wsSource.Rows(i).Copy Destination:=wsDest.Rows(destRow) destRow = destRow + 1 End If Next i MsgBox ThisWorkbook.Sheets("Langue").Range("E29").Value, vbInformation, "Succes" Unload UserForm1 wsDest.Activate wsDest.Range("A10").Select End Sub