Option Explicit 'oblige à déclarer toutes les variables
Option Compare Text 'utilise le texte pour le classement alphabétique
Private x As Variant 'déclare la variable x
Private pl As Range 'déclare la variable pl (PLage)
Private cel As Range 'déclare la variable cel (CELlule)
Private nl As Long 'déclare la variable nl (Numéro de Lige)
Private Sub UserForm_Activate()
'Date et heure
Label238.Caption = "Nous somme le : " & Format(Now(), "dd mmmm yyyy") & ", il est " & Format(Now(), "hh : mm") & " heure"
' Position de l'USF sur l'ecran
With UserForm1
.Top = Application.Top + 150 ' ^ Position du vers le bas^
.Left = Application.Left + 300 '< Position de la gauche vers la droite
End With
End Sub
Private Sub UserForm_Initialize()
Call obG1
'Agrandir formulaire sur la hauteur et la largeur
UserForm1.Top = 10
UserForm1.ScrollLeft = 10
UserForm1.Width = 330
UserForm1.Height = 150
End Sub
Private Sub OptionButton1_Click()
Call obG1
'Agrandir formulaire sur la hauteur
UserForm1.Width = 330.5
UserForm1.Height = 540.5
'Agrandir formulaire sur la Largeur
UserForm1.Width = 720
End Sub
Private Sub OptionButton2_Click()
Call obG1
'Agrandir formulaire sur la hauteur
UserForm1.Width = 330.5
UserForm1.Height = 540.5
End Sub
Private Sub OptionButton3_Click()
Call obG2
End Sub
Private Sub OptionButton4_Click()
Call obG2
End Sub
Private Sub ComboBox1_DropButtonClick()
If Me.ComboBox1.ListCount = 0 Then
MsgBox "Vous devex choisir le type de recherche ! PAR RACE OU PAR GROUPE."
Me.OptionButton3.SetFocus
End If
End Sub
Private Sub ComboBox1_Change()
Dim Tablo()
Dim i As Integer, Indice As Integer
'Agrandir formulaire sur la Largeur
UserForm1.Width = 720
Indice = 1
Me.ListBox1.Clear
For Each cel In pl
If CStr(cel.Value) = CStr(Me.ComboBox1.Value) Then
nl = cel.Row
Indice = Indice + 1
ReDim Preserve Tablo(1 To 13, 1 To Indice)
For i = 1 To 12
Tablo(i, Indice) = Sheets("Feuil1").Cells(nl, i)
Next i
Tablo(i, Indice) = nl
End If
Next cel
If Indice > 1 Then
Me.ListBox1.List = Application.Transpose(Tablo)
Me.ListBox1.RemoveItem (0) ' On supprime l'enregistrement vide
If Me.ListBox1.ListCount = 1 Then Me.ListBox1.ListIndex = 0
End If
End Sub
Private Sub listbox1_Click()
Dim Chemin As String, Dl As Integer
' ****************************************************
' Indiques exactement le répertoire de tes images
' ****************************************************
Chemin = "C:\Users\Max\Desktop\Dosier_animal\Photos_Chien\"
With Sheets("Feuil1")
Dl = .Range("A" & .Rows.Count).End(xlUp).Row
nl = .Range("A2:A" & Dl).Find(ListBox1).Row
For x = 1 To 12
Me.Controls("TextBox" & x).Value = .Cells(nl, x)
Next x
End With
On Error Resume Next
Me.Label14.Picture = LoadPicture(Chemin & Me.ListBox1 & ".jpg")
If Err <> 0 Then
On Error GoTo 0
Me.Label14.Picture = LoadPicture(Chemin & "vide.jpg")
MsgBox "pas d'image disponible pour cet animal"
End If
On Error GoTo 0
With Me.TextBox1
'.SetFocus
.SelStart = 0
.SelLength = Len(.Value)
End With
End Sub
Private Sub CommandButton1_click()
Dim dest As Range
With Sheets("Feuil1")
If nl = 0 Then
Set dest = .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
Else
Set dest = .Cells(nl, 1)
End If
End With
For x = 1 To 7
dest.Value = Me.Controls("TextBox1").Value
dest.Offset(0, x).Value = Me.Controls("TextBox" & x + 1).Value
Next x
Unload Me
UserForm1.Show
End Sub
Private Sub CommandButton2_click()
Unload Me
End Sub
Private Sub obG1()
UserForm1.Frame1.Visible = UserForm1.OptionButton2.Value
If Me.OptionButton1.Value = True Then
For x = 1 To 12
Me.Controls("TextBox" & x).Value = "" 'Vider textBox
Me.Label14.Picture = LoadPicture("") 'Vider label14
Me.Image1.Picture = LoadPicture("") 'Vider image1
Next x
Me.TextBox1.SetFocus
nl = 0
End If
End Sub
Private Sub obG2()
Dim col As Variant
Dim dico As Object
Dim tbl As Variant
Dim i As Variant
Dim j As Variant
Dim temp As Variant
UserForm1.ComboBox1.Clear
col = IIf(UserForm1.OptionButton3.Value = True, 1, 2)
With Sheets("Feuil1")
Set pl = .Range(.Cells(2, col), .Cells(Application.Rows.Count, col).End(xlUp)) 'définit la plage pl
End With
Set dico = CreateObject("scripting.dictionary")
For Each cel In pl
dico(cel.Value) = ""
Next cel
tbl = dico.keys
For i = 0 To UBound(tbl, 1)
For j = 0 To UBound(tbl, 1)
If tbl(i) < tbl(j) Then
temp = tbl(i)
tbl(i) = tbl(j)
tbl(j) = temp
End If
Next j
Next i
UserForm1.ComboBox1.List = tbl
End Sub
'Image Drapeaux
Private Sub TextBox4_Change()
On Error Resume Next
Me.Image1.PictureSizeMode = fmPictureSizeModeZoom
Me.Image1.Picture = LoadPicture(ThisWorkbook.Path & "\Photo_flag\" & Me.TextBox4 & ".jpg")
If Err <> 0 Then MsgBox Me.TextBox4 & ".jpg introuvable (ou mal orthographié)"
End Sub
Private Sub SpinButton1_SpinDown()
With ComboBox1
If .ListIndex < .ListCount - 1 Then .ListIndex = .ListIndex + 1
End With
End Sub
Private Sub SpinButton1_SpinUp()
With ComboBox1
If .ListIndex > 0 Then .ListIndex = .ListIndex - 1
End With
End Sub
