Private Adr As String
Private Li As Integer 'déclare la varible li
Private Sub Userform_initialize() 'à l'initialisation de l'Userform'
' pour mise au point
'col = 1: NomDefini = "pays"
'*******************
RemplirListbox
Me.MultiPage1.Value = 0 'définit la page active
End Sub
Private Sub CommandButton1_Click() 'bouton "ajouter"
Dim L As Long
If Me.TextBox1.Value = "" Then
Call MsgBox("Vouds devez indiquer un : " & NomDefini, vbExclamation, "")
End If
'condition : si la TextBox1 n'est pas vide
TextBox1 = StrConv(Application.WorksheetFunction.Trim(TextBox1.Value), vbProperCase)
'prend en compte l'onglet "paramètres" *
For i = 0 To ListBox1.ListCount - 1
If ListBox1.List(i) = TextBox1 Then
MsgBox TextBox1.Value & " Existe déjà"
Me.TextBox1.Value = ""
Me.TextBox1.SetFocus
Exit Sub
End If
Next i
L = CLng(ListBox1.List(ListBox1.ListCount - 1, (ListBox1.ColumnCount - 1))) + 1
Sheets("parametres").Cells(ListBox1.ListCount + 1, col) = TextBox1
'mise à jour des composants de la ListBox1
TrierColonne
RemplirListbox
EffaceTextBox
End Sub
Private Sub CommandButton2_Click() 'bouton "sortir" (page "ajouter")
mv = 0 'réinitialise la variable mv (déclarée publique)
col = 0
Unload Me 'vide et ferme l'UserForm
End Sub
Private Sub ListBox1_Click() 'au clic dans la ListBox1
'définit la variable li (utilise la fonction "Rechercher" (Find) pour le numéro de la ligne dans lequel se trouve la donnée recherchée)
Adr = ListBox1.List(ListBox1.ListIndex, 1)
End Sub
Private Sub CommandButton3_Click() 'bouton "supprimer"
'condition : si "oui" au message, supprime la donnée dans l'onglet "Liste"
If MsgBox("Êtes-vous sûr(e) de vouloir supprimer cette donnée ?", vbYesNo, "ATTENTION !") = vbYes Then
Sheets("parametres").Range(Adr).Delete Shift:=xlShiftUp 'suppression de la donnée
End If 'fin de la condition
'mise à jour des composants de la ListBox1
TrierColonne
RemplirListbox
EffaceTextBox
Adr = ""
End Sub
Private Sub CommandButton4_Click() 'bouton "annuler" (page "supprimer")
CommandButton2_Click
End Sub
Private Sub ListBox2_Click() 'au clic dans la ListBox2
Me.TextBox2.Value = Me.ListBox2.Value 'place le contenu de la donnée sélectionnée dans la TextBox2
Adr = ListBox1.List(ListBox1.ListIndex, 1)
'définit la variable li (utilise la fonction "Rechercher" (Find) pour le numéro de la ligne dans lequel se trouve la donnée recherchée)
On Error Resume Next 'vite le bug si on délectionne une donnée dans la page "modifier" et on change de page...
'sélection de l'ancienne donnée
Me.TextBox2.SetFocus 'place le curseur dans la TextBox2
Me.TextBox2.SelStart = 0 'début de la sélection
Me.TextBox2.SelLength = Len(Me.TextBox2.Value) 'longueur de la sélection
End Sub
Private Sub CommandButton6_Click() 'bouton "modifier"
'condition : si "oui" au message, modifie la donnée dans l'onglet "Liste"
TextBox2 = StrConv(Application.WorksheetFunction.Trim(TextBox2.Value), vbProperCase)
If MsgBox("Êtes-vous sûr(e) de vouloir modifier cette donnée ?", vbYesNo, "ATTENTION !") = vbYes Then
Sheets("parametres").Adr.Value = Me.TextBox2.Value 'remplace la donnée par le contenu de la TextBox2'
End If 'fin de la condition
'mise à jour des composants de la ListBox2
TrierColonne
RemplirListbox
EffaceTextBox
Adr = ""
End Sub
Private Sub CommandButton5_Click() 'bouton "sortir" (page "modifier")
CommandButton2_Click
End Sub
Private Sub RemplirListbox()
Dim Dl1 As Long
Dim Plg1 As Range
Dim cellule As Range
Dl1 = Worksheets("parametres").Cells(Columns(col).Cells.Count, col).End(xlUp).Row
Set Plg1 = Worksheets("parametres").Range(Cells(1, col), Cells(Dl1, col))
With Me.ListBox1
.Clear
.ColumnCount = 3
.ColumnWidths = "200;0;0"
For Each cellule In Plg1
.AddItem cellule.Value
.List(.ListCount - 1, 1) = cellule.Address
.List(.ListCount - 1, .ColumnCount - 1) = cellule.Row
Next cellule
End With
With Me.ListBox2
.Clear
.List = Me.ListBox1.List
End With
End Sub
Private Sub TrierColonne()
Dim Dl1 As Long
Dim Plg1 As Range
Dim Plg2 As Range
Dl1 = Worksheets("parametres").Cells(Columns(col).Cells.Count, col).End(xlUp).Row
Set Plg1 = Worksheets("parametres").Range(Cells(1, col), Cells(Dl1, col))
Set Plg2 = Worksheets("parametres").Range(Cells(1, col), Cells(1, col))
Plg1.Sort Key1:=Plg2
End Sub
Private Sub EffaceTextBox()
Dim ctrl As MSForms.Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then
ctrl = ""
End If
Next ctrl
End Sub
rojet ou bibliothèque introuvable.
