''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)
Dim b As Boolean
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"
If Not b Then 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 11
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
b = True
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
b = False
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
