Modifier et ajouter dans une combobox

Bonjour,

Pouvez-vous m'aider ?

J'ai un fichier avec usf et 5 combobox

J'aimerais ajouter un bouton pour pouvoir ajouter ou modifier dans la combobox.

Malheureusement je n'y arrive pas.

Je mettrai le fichier plus tard, je suis sur mon portable.

Merci

Hello,

Un exemple (il faudra sécuriser davantage pour une bonne utilisation) :

Le principe : 1 combo/1 textbox / 3 boutons

1 ajouter => ajouter de la donnée dans le textbox puis cliquer dessus

2 modifier => sélectionner un élément dans la combo + ajouter de la donnée dans le textbox puis cliquer dessus

3 supprimer => sélectionner un élément dans la combo puis cliquer dessus

Bonsoir,

Merci beaucoup

C'est pas mal mais comme je suis débutant je n'arrive pas à l'adapter.

Je n'ai que des erreurs

Pouvez-vous me faire un exemple avec une dizaine de données?

j'ai pu lire mes données dans la combo mais plantage au moment de supprimer ou d'ajouter.

merci

Bonjour,

Je suppose qu'il s'agit toujours du fichier de traduction en plusieurs langues, si c'est bien le cas voici:

-Ajout des boutons "Ajouter" et "Modifier"

-un label en haut à gauche du formulaire pour mémoriser la ligne à remplacer lors d'une modification.

Pour la modification, sélectionnez le mot ou phrase à traduire, cliquez sur "Traduction" puis, faites la modification et, cliquez sur "Modifiez"

Cdlt

Bonjour,

Oui tu suppose bien Arturo83

Excellent!

Mais 2 petites erreurs

1-Si on clic sur Modifier avec les combo vide = plantage

2-Si on choisi un mot dans une combo et qu'on clic sur ajouter = ajout du mot seul et 3 combo vides

Pour la 1 j'ai essayé de mettre ceci :

Dim i As Long
For i = 1 To 5
If Controls("Combobox" & i) = "" Then MsgBox (" Vous n'avez rien écrit..." & Chr(10) & " OK pour sortir")
Next i

Mais pas ok

Peut-on ajouter un bouto "Supprimer" ?

Merci pour ton aide

@ bientôt

Pour la question 1, il suffit de tester le contenu du label (Label14) en haut à gauche du formulaire, s'il est vide on sort de ma macro.

Private Sub Modifier_Click()
    If Label14 <> "" Then
        Sheets("Traduction").Range("A" & Label14.Caption) = ComboBox1
        Sheets("Traduction").Range("B" & Label14.Caption) = ComboBox2
        Sheets("Traduction").Range("C" & Label14.Caption) = ComboBox3
        Sheets("Traduction").Range("D" & Label14.Caption) = ComboBox4
        Sheets("Traduction").Range("E" & Label14.Caption) = ComboBox5
    End If
End Sub

Pour la question 2, puisqu'il s'agit d'un ajout, il faut remplir les 5 combobox.

Le fichier avec la modification liée à la question1

Bonjour

ok

mais pour la question 2 on pourrait mettre une MsgBox pour dire qu'il faut remplir toutes les cases?

pour le bouton supprimer j'ai mis ça (au pif):

Private Sub Supprimer_Click()
  Dim DerLig_Trad As Long
    DerLig_Trad = Sheets("Traduction").Range("A1").CurrentRegion.Rows.Count

    Sheets("Traduction").Range("A" & Label14.Caption) = Sheets("Traduction").Range("A" & DerLig_Trad - 1)
    Sheets("Traduction").Range("B" & Label14.Caption) = Sheets("Traduction").Range("B" & DerLig_Trad - 1)
    Sheets("Traduction").Range("C" & Label14.Caption) = Sheets("Traduction").Range("C" & DerLig_Trad - 1)
    Sheets("Traduction").Range("D" & Label14.Caption) = Sheets("Traduction").Range("D" & DerLig_Trad - 1)
    Sheets("Traduction").Range("E" & Label14.Caption) = Sheets("Traduction").Range("E" & DerLig_Trad - 1)

End Sub

mais par contre si on choisi un mot ->clic sur traduction->clic sur ajouter = doublon

je peux ajouter une macro pour supprimer les doublons mais moins joli que vos codes

merci

Voilà la modif, ajoutez-y la macro "Supprimer" que vous venez de créer.

Merci pour ton aide

J'ai une erreur 13 quand je clic sur "AJOUTER"

Modifier c'est OK

et mes codes "supprimer" ne suppriment rien du tout

à bientôt

Voilà:

Bonjour,

c'est super

Par contre je voudrais insérer une macro qui supprime les lignes vides (j'ai déjà la macro)

Je n'arrive pas à la faire fonctionner sans activer la feuille "Traduction"

comment faire?

j'ai essayé avec(f = sheets("Traduction")..etc) comme vous avez fait pour lire les mots sans l'ouvrir, mais sans succés.

Sub SupprimerLignes_Vides() ' supprime lignes vides
Dim DernièreLigne As Long
Dim r As Long
DernièreLigne = ActiveSheet.UsedRange.Row - 1
DernièreLigne = DernièreLigne + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = DernièreLigne To 1 Step -1
If Application.WorksheetFunction.CountA(Rows(r)) = 0 Then
Rows(r).Delete
End If
Next r
End Sub

Merci beaucoup

et beau travail

Copiez ceci dans un module standard:

Sub SupprimerLignes_Vides() ' supprime lignes vides
    Dim DernièreLigne As Long, r As Long
    Application.ScreenUpdating = False
    Set Sh = Sheets("Traduction")
    DernièreLigne = Sh.Range("A" & Rows.Count).End(xlUp).Row
    For r = DernièreLigne To 1 Step -1
        If Application.WorksheetFunction.CountA(Range(Cells(r, "A"), Sh.Cells(r, "D"))) = 0 Then Rows(r).Delete
    Next r
    set Sh = nothing
End Sub

Merci

mais

Erreur 1004

La méthode 'Range' de l'objet _Global'a échoué

sur cette ligne

    If Application.WorksheetFunction.CountA(Range(Cells(r, "A"), Sh.Cells(r, "D"))) = 0 Then Rows(r).Delete

@bientôt

Un petit oubli, au cas ou vous lanceriez la macro à partir de la feuille "Jeu" (il manquait 2 "Sh.")

Sub SupprimerLignes_Vides() ' supprime lignes vides
    Dim DernièreLigne As Long, r As Long
    Application.ScreenUpdating = False
    Set Sh = Sheets("Traduction")
    DernièreLigne = Sh.Range("A" & Rows.Count).End(xlUp).Row
    For r = DernièreLigne To 1 Step -1
        If Application.WorksheetFunction.CountA(Range(Sh.Cells(r, "A"), Sh.Cells(r, "E"))) = 0 Then Sh.Rows(r).Delete
    Next r
    Set Sh = Nothing
End Sub

Super beau boulot

BRAVO!

Je vais pouvoir finir cette appli

Merci beaucoup de ton aide

@ bientôt

Bonjour Arturo83,

J'ai encore une ou deux petites questions :

1- Peut-on avoir les 5 combobox triées par ordre Alphabétique sans mélanger les colonnes?

Là, j'ai juste trié la colonne A(français) directement dans la feuille.

On m'a dit que c'était très compliqué d'avoir ce résultat, vrai ou faux?

2- Peut-on insérer un site web dans la feuille 'Jeu' ou dans la usf de façon à avoir ce site ?

j'ai déjà recherché ici et ailleurs, mais sans succés

traduction anglais français - Rechercher (bing.com)

pas la peine je viens de m'apercevoir que la USF bloque tout, mais on peut travailler en parallèle avec le site donc inutile mon idée

Par contre un bouton qui ouvrirait ce site directement sur une page à côté d'excel, c'est possible?

Merci

Bonjour,

1- Peut-on avoir les 5 combobox triées par ordre Alphabétique sans mélanger les colonnes? On m'a dit que c'était très compliqué d'avoir ce résultat, vrai ou faux?

On n'est pas obligé de chercher des complications, une seule ligne suffit pour trier chaque colonne sans se lancer dans du code compliqué, ici l'ajout de la ligne suivante:

        Range(f.Cells(2, "A"), f.Cells(DerLig, "E")).Sort f.Cells(1, i), 1

dans la boucle du code:

Private Sub UserForm_initialize()
    Dim d As Object
    Dim Combo As Variant
    Dim c As Range
    Dim i As Integer, DerLig As Integer
    'Dim deb As Double
    Set f = Sheets("Traduction")
    'deb = Timer
    For i = 1 To 5
        Controls("Combobox" & i) = ""
    Next i

    Set d = CreateObject("Scripting.Dictionary")
    Combo = Array("ComboBox1", "ComboBox2", "ComboBox3", "ComboBox4", "ComboBox5")
    For i = 1 To 5
        DerLig = f.Cells(Rows.Count, i).End(xlUp).Row
        Range(f.Cells(2, "A"), f.Cells(DerLig, "E")).Sort f.Cells(1, i), 1
        For Each c In Range(f.Cells(2, i), f.Cells(DerLig, i))
            d(c.Text) = "" 'If Not d.exists(c.Text) And c.Text <> "" Then d(c.Text) = "" '
        Next c
        Me(Combo(i - 1)).List = d.keys
        d.RemoveAll
    Next i
    Label14 = ""
    'MsgBox Timer - deb
End Sub

pas la peine je viens de m'apercevoir que la USF bloque tout, mais on peut travailler en parallèle avec le site donc inutile mon idée. Par contre un bouton qui ouvrirait ce site directement sur une page à côté d'excel, c'est possible?

Quel Site?

Merci beaucoup

EXCELLENT une seule et petite ligne et le tri est fait, Grandiose

Le lien que j'ai mis pour le site que j'ai barré en vert

Ci-joint le fichier modifié

ça rame un peu à l'ouverture de l'USF mais ça va encore

par contre ça rame énormément si je clic sur "EFFACER"

le reste c'est tout Ok

@ bientôt

ça rame un peu à l'ouverture de l'USF mais ça va encore, c'est un peu normal, vous lui demandez de scruter toute la BDD pour supprimer les lignes vides, alors que vous pourriez créer un bouton dans la BDD affecté à la macro "SupprimerLignes_Vides" et lancer cette macro à la demande.

par contre ça rame énormément si je clic sur "EFFACER", Pourquoi recharger l'userform puisqu'il est déjà ouvert? Pourquoi vouloir effacer les doublons puisqu'on ne veut effacer que la saisie dans les comboboxes?

Ceci ne suffirait-il pas?

Private Sub Effacer_Click()
    On Error GoTo fin
    For i = 1 To 5
        Controls("Combobox" & i) = ""
    Next i
    Label14 = ""
fin:
    If Err.Number <> 0 Then MsgBox "ARRÊT..." & Chr(10) & Chr(10) & " OK pour sortir"
End Sub

Bonjour,

je me suis permis de tester et du coup j'ai modifié le code "Traduction", pourquoi ?
Parce que je clic partout , en fait j'ai choisi un mot français, puis traduction, affichage de tous les mots, puis j'ai choisi un mot anglais, puis traduction et c'est celle du français qui s'est ré affiché ! Avec le code suivant, le code met en mémoire la dernière combobox modifiée, du coup en traduisant c'est bien elle qui est prise en compte :

Option Explicit

Dim f As Worksheet, cell As Range
Dim i&, ln&, col&, flag&
Dim ValChange As Integer

Private Sub ComboBox1_Change()
    ValChange = 1
End Sub

Private Sub ComboBox2_Change()
    ValChange = 2
End Sub

Private Sub ComboBox3_Change()
    ValChange = 3
End Sub

Private Sub ComboBox4_Change()
    ValChange = 4
End Sub

Private Sub ComboBox5_Change()
    ValChange = 5
End Sub

Private Sub CommandButton1_Click()
On Error GoTo fin
    flag = 0
    If Controls("Combobox" & ValChange) <> "" Then col = ValChange:   flag = 1
'    flag = 0
'    For i = 1 To 5
'        If Controls("Combobox" & i) <> "" Then
'            col = i
'            flag = 1
'            Exit For
'        End If
'    Next i
    If flag = 1 Then
        Set cell = f.Range(f.Cells(2, col), f.Cells(Rows.Count, col).End(xlUp)).Find(Controls("Combobox" & ValChange), lookat:=xlWhole)
        If Not cell Is Nothing Then
            ln = cell.Row
            ComboBox1 = f.Cells(ln, 1)
            ComboBox2 = f.Cells(ln, 2)
            ComboBox3 = f.Cells(ln, 3)
            ComboBox4 = f.Cells(ln, 4)
            ComboBox5 = f.Cells(ln, 5)
        Else
            MsgBox "'' " & Controls("Combobox" & i) & " '' ne figure pas sur le tableau." _
                & " dans la colonne " & Cells(1, col) & "." _
                & vbLf & "Attention à l'orthographe et aux majuscules !", 16

            Exit Sub
        End If
    End If
      Label14 = ln
      Call SupprimerLignes_Vides
fin:
    If Err.Number <> 0 Then MsgBox "ARRÊT..." & Chr(10) & Chr(10) & " OK pour sortir"

End Sub

@ bientôt

LouReeD