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
نسعد بتعليقاتكم