Option Explicit
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Sub ComboBox1_Change()
Me.TextBox1.Text = Me.ComboBox1.List(Me.ComboBox1.ListIndex, 1)
End Sub
Private Sub ComboBox2_Change()
Me.TextBox2.Text = Me.ComboBox2.List(Me.ComboBox2.ListIndex, 1)
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub SDate_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
'Curseur en surbrillance sur textBox
With SDate
.SetFocus
.SelStart = 0
.SelLength = Len(SDate.Text)
End With
End Sub
Private Sub SDate_Change()
Dim Valeur As Byte
'On autorise la saisie de 10 caractères maximum
SDate.MaxLength = 10
End Sub
Private Sub SDate_KeyPress(ByVal Keycode As MSForms.ReturnInteger)
'On autorise uniquement la saisie des caractères "0123456789"
If InStr("0123456789", Chr(Keycode)) = 0 Then Keycode = 0
End Sub
Private Sub SDate_KeyUp(ByVal Keycode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim Valeur As Byte
'Si l'utilisateur presse la touche "Suppr" ou la touche "Del" (<-) alors quitte la procédure
If Keycode = 10 Or Keycode = 46 Then Exit Sub
Valeur = Len(SDate)
'Si le jour ou le mois est inscrit, alors ajoute un "/" automatiquement
If Valeur = 2 Or Valeur = 5 Then
SDate = SDate & "/"
End If
'Si la date inscrite contient 8 caractères = date complète
If Valeur = 8 Then
If Not IsDate(Me.SDate) Then
MsgBox "Veuillez entrer une date valide."
SDate.Value = ""
Exit Sub
End If
End If
End Sub
Private Sub SDate_Exit(ByVal c As MSForms.ReturnBoolean) 'Teste date In
Dim Valeur As Byte
Dim datemois As String
datemois = ActiveSheet.Range("C2") 'Date du 1er jour du mois pour controle date de saisie
Valeur = Len(SDate)
If Valeur = 0 Then Exit Sub
If Valeur < 10 Or Valeur = 0 Then
MsgBox "Veuillez entrer une date valide !"
SDate.Value = ""
CreateObject("wscript.shell").SendKeys "+{TAB}", False
'ElseIf Valeur = 8 And Mid(SDate.Value, 7, 2) < Mid(Sheets("Outils").Range("D2"), 3, 2) Then
'MsgBox "Veuillez entrer une date valide >" & Sheets("Outils").Range("D2") & "."
'SDate.Value = ""
' SendKeys "+{TAB}", False
ElseIf Mid(SDate.Value, 7, 4) <> Mid(datemois, 7, 4) Then
MsgBox "Veuillez entrer une date valide ou appartenant à la période de " & ActiveSheet.Range("C4").Value & " " & ActiveSheet.Range("C5").Value
SDate.Value = ""
CreateObject("wscript.shell").SendKeys "+{TAB}", False
End If
End Sub
Private Sub SDate_AfterUpdate()
SDate.Value = Format(SDate.Value, "dd/mm/yyyy")
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet, x As String
Dim Drl As Integer, c As Range, a As Double, b As Double, Taille As Double
Dim nb As Integer, nb2 As Integer, nb_max As Integer, nbrow As Long, k As Long, n As Long, n2 As Long, k2 As Long, nb_max2 As Integer
Dim nb_ As Integer, nb2_ As Integer
Dim hwnd As Long
Dim style
Dim i As Integer
Dim j As Integer
Dim TailleCol As Integer
Dim SizeCol As String
hwnd = FindWindow(vbNullString, Me.Caption)
style = GetWindowLong(hwnd, -16) And &HFFF7FFFF 'Supprime uniquement la croix rouge de fermture
'style = GetWindowLong(hwnd, -16) And Not &HC00000 'supression de la barre de titre...
SetWindowLong hwnd, -16, style
DrawMenuBar hwnd
With Sheets("Paramétrage")
With .ListObjects("t_Code")
Me.ComboBox1.RowSource = .DataBodyRange.Address(, , , True)
For j = 1 To 2 'on détermine la taille maxi des colonnes
For i = 1 To .ListRows.Count
TailleCol = WorksheetFunction.Max(TailleCol, Len(.DataBodyRange(i, j)))
Next i
SizeCol = SizeCol & TailleCol * 8 & ";"
Next j
SizeCol = Left(SizeCol, Len(SizeCol) - 1)
With Me.ComboBox1
.ColumnCount = 2
.ColumnWidths = SizeCol ''.ColumnWidths = nb_max * 6 & ";" & nb_max2 * 6
.Font.Name = "Tahoma"
.Font.Size = 10
.Width = 80
.ListWidth = 300
End With
End With
With .ListObjects("t_Compte")
Me.ComboBox2.RowSource = .DataBodyRange.Address(, , , True)
For j = 1 To 2 'on détermine la taille maxi des colonnes
For i = 1 To .ListRows.Count
TailleCol = WorksheetFunction.Max(TailleCol, Len(.DataBodyRange(i, j)))
Next i
SizeCol = SizeCol & TailleCol * 8 & ";"
Next j
SizeCol = Left(SizeCol, Len(SizeCol) - 1)
With Me.ComboBox2
.ColumnCount = 2
.ColumnWidths = SizeCol ''.ColumnWidths = nb_max * 6 & ";" & nb_max2 * 6
.Font.Name = "Tahoma"
.Font.Size = 10
.Width = 80
.ListWidth = 300
End With
End With
End With
Me.ComboBox1.ListIndex = 0
Me.ComboBox2.ListIndex = 0
Me.ComboBox1.SetFocus ' Positionne le curseur sur Code journal
End Sub