#If VBA7 Then
Private Declare PtrSafe Function GetDC Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd as long) as long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC as long, ByVal nIndex as long) as long
#End If
Option Explicit
Dim Target As Range
Dim DerLigne As Long
Private Sub CommandButton1_Click()
Insert_Rows
End Sub
Sub Insert_Rows()
Dim N As Integer
Application.ScreenUpdating = False
Target.AutoFilter Field:=2, Criteria1:=TextBox1
Target.AutoFilter Field:=3, Criteria1:=TextBox2
If Target.SpecialCells(xlCellTypeVisible).Cells.Count > 3 Then
' 3 cellules d'entetes ==> pas de lignes filtrées
Me.Caption = TextBox1 & " - " & TextBox2 & " déja existant"
Beep
Else
Target.AutoFilter
Rows(2).Insert xlDown, xlFormatFromRightOrBelow
Cells(2, "B") = CDate(TextBox1)
Cells(2, "C") = TextBox2
DerLigne = DerLigne + 1
Me.Caption = TextBox1 & " - " & TextBox2 & " Inséré"
' on trie par date et par n° de facture
Set Target = Range("A1:C" & DerLigne)
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Target.Columns("B"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Target.Columns("C"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.SetRange Target
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' on renumérote la colonne A
With Columns("A").Rows("2:" & DerLigne)
.NumberFormat = "General"
.FormulaR1C1 = "=ROW()-1"
.Value = .Value
End With
Target.AutoFilter Field:=2, Criteria1:=TextBox1
Target.AutoFilter Field:=3, Criteria1:=TextBox2
End If
N = Target.SpecialCells(xlCellTypeVisible).Find(TextBox2).Row
Target.AutoFilter Field:=3
Target.Rows(N).Select
TextBox2 = vbNullString
Application.ScreenUpdating = True
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1 <> "" Then
TextBox1 = Format(TextBox1, "dd/mm/yyyy")
Target.AutoFilter Field:=2, Criteria1:=TextBox1
Target.AutoFilter Field:=3
End If
CommandButton1.Visible = TextBox1 <> ""
End Sub
Private Sub UserForm_Initialize()
Caption = vbNullString
CommandButton1.Visible = TextBox1 <> ""
Worksheets("primanota").Activate
DerLigne = Range("A" & Rows.Count).End(xlUp).Row
Set Target = Range("A1:C" & DerLigne)
If Not ActiveSheet.AutoFilter Is Nothing Then Target.AutoFilter
' Move_Usf ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(1)
Move_Usf ActiveSheet.[D2]
End Sub
Private Sub Move_Usf(Cellule As Range)
Dim X As Double, Y As Double
ActiveWindow.Zoom = 100
X = GetDeviceCaps(GetDC(0), 88) / 72 'Logical pixels/point in X
Y = GetDeviceCaps(GetDC(0), 90) / 72 'Logical pixels/point in Y
StartUpPosition = 0
Left = ActiveWindow.PointsToScreenPixelsX(Cellule.Left * X) * 1 / X
Top = ActiveWindow.PointsToScreenPixelsY(Cellule.Top * Y) * 1 / Y
End Sub
Private Sub UserForm_Terminate()
If Not ActiveSheet.AutoFilter Is Nothing Then Target.AutoFilter
End Sub