Private Sub UserForm_Initialize() Dim List_Donnees(), i As Integer 'remplissage de la variable tableau des valeurs à ajouter à la combobox List_Donnees = Sheets("Feuil1").Range("A1:A25").Value With ComboBox1 'permet la saisie "informatisée" des valeurs dans la ComboBox .Style = fmStyleDropDownCombo For i = LBound(List_Donnees) To UBound(List_Donnees) 'ajout dans la combobox sans doublons .Value = List_Donnees(i, 1) If .ListIndex = -1 Then .AddItem List_Donnees(i, 1) Next 'empêche la saisie d'autres valeurs que celles présentes dans la ComboBox .Style = fmStyleDropDownList .ListIndex = -1 End With End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionComboBox1.RowSource = "Feuil1!A1:D4"
Private Sub CommandButton1_Click()
With Worksheets("DONNEES")
derlig = .Range("A" & Rows.Count).End(xlUp).Row
If WorksheetFunction.CountIf(.Range("A1:A" & derlig), TextBox1.Text) = 0 Then
.Range("A" & derlig + 1).Value = TextBox1.Text
mise_a_jour
TextBox1.Text = ""
End If
End With
End Sub
Private Sub UserForm_Activate()
mise_a_jour
End Sub
Private Sub mise_a_jour()
' on trie systématiquement
With ActiveWorkbook.Worksheets("DONNEES").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A:A"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A:A")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' on lie la combo (on lui affecte la totalité des lignes non vides
With ComboBox1
On Error Resume Next
.RowSource = "DONNEES!" & Worksheets("DONNEES").Range("A:A").SpecialCells(xlCellTypeConstants).Address
If Err Then .RowSource = ""
On Error GoTo 0
.Style = 2
.MatchEntry = fmMatchEntryComplete
.MatchRequired = True
.ColumnCount = 1
End With
End Sub
Option Explicit
Private Sub UserForm_Activate()
Set F = Worksheets("DONNEES")
tri
maj ComboBox1
End Sub
Private Sub CommandButton1_Click()
With F
Dim ajout As String, n As Long, derl As Long
ajout = "on s'en moque": n = 1
Do While Not ajout = ""
ajout = Trim(InputBox("Ajout mot " & n, "AJOUTER DES MOTS"))
If WorksheetFunction.CountIf(.Range("A:A"), ajout) = 0 Then
derl = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & derl).Value = ajout
n = n + 1
Else
If ajout <> "" Then MsgBox "ce mot existe déjà !"
End If
Loop
tri
maj Me.ComboBox1
End With
End Sub
Private Sub CommandButton2_Click()
If ComboBox1.ListIndex = -1 Then
MsgBox "aucun mot n'a été sélectionné"
Exit Sub
End If
Dim mot As String
mot = "on s'en moque"
Do Until mot = ""
mot = Trim(InputBox("Remplacer le mot " & ComboBox1.List(ComboBox1.ListIndex) & " par ", "CORRECTION DU MOT " & ComboBox1.List(ComboBox1.ListIndex)))
If WorksheetFunction.CountIf(F.Range("A:A"), mot) = 0 Then
F.Range("A" & ComboBox1.ListIndex + 1).Value = mot
tri
Exit Sub
Else
MsgBox mot & " existe déjà !": mot = "": Exit Sub
End If
Loop
End Sub
Private Sub CommandButton3_Click()
If ComboBox1.ListIndex = -1 Then
MsgBox "aucun mot n'a été sélectionné"
Exit Sub
End If
F.Range("A" & ComboBox1.ListIndex + 1).Value = ""
tri
maj ComboBox1
End Sub
Public F As Worksheet
Public Sub tri()
With F.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A:A"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A:A")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Public Sub maj(cb As ComboBox)
With cb
On Error Resume Next
.RowSource = F.Name & "!" & F.Range("A:A").SpecialCells(xlCellTypeConstants).Address
If Err Then .RowSource = ""
On Error GoTo 0
.Style = 2
.MatchEntry = fmMatchEntryComplete
.MatchRequired = False
.ColumnCount = 1
End With
End Sub
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Range("B" & Target.Row).Select: Exit Sub
If Target.Column = 1 Then
Target.Offset(0, 1).Select
Target.Offset(0, 1).Value = ""
MsgBox "les données de cette colonne sont à manipuler à l'aide des seuls bolutons ad hoc"
End If
End Sub
Private Sub CommandButton1_Click()
Dim ajout As String, n As Long, derl As Long
Set F = ActiveSheet
ajout = "on s'en moque": n = 1
Do While Not ajout = ""
With F
ajout = Trim(InputBox("Ajout mot " & n, "AJOUTER DES MOTS"))
If WorksheetFunction.CountIf(.Range("A:A"), ajout) = 0 Then
derl = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & derl).Value = ajout
n = n + 1
Else
If ajout <> "" Then MsgBox "ce mot existe déjà !"
End If
End With
Loop
tri
End Sub
Private Sub CommandButton2_Click()
Dim choix As Range, mot As String
Application.DisplayAlerts = False
On Error Resume Next
Set choix = Application.InputBox("Cliquez sur le mot à corriger ou annulez", "corriger des mots", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If choix Is Nothing Then Exit Sub
mot = "on s'en moque"
Do Until mot = ""
mot = Trim(InputBox("Remplacer le mot " & choix.Text & " par ", "CORRECTION DU MOT " & choix.Text))
If WorksheetFunction.CountIf(Range("A:A"), mot) = 0 Then
choix.Value = mot: Exit Do
Else
If mot <> "" Then MsgBox "ce mot existe déjà !": mot = ""
End If
Loop
tri
End Sub
Private Sub CommandButton3_Click()
Dim choix As Range
Application.DisplayAlerts = False
On Error Resume Next
Set choix = Application.InputBox("Cliquez sur le mot à supprimer ou annulez", "supprimer un mot", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If choix Is Nothing Then Exit Sub
choix.Value = ""
tri
End Sub