Sauvegarder automatiquement les données de mes 4 combobox

marcelio · 23 Avril 2014

Bonjour le forum,
Après plusieurs recherche sur le forum et de tentative, je ne suis pas arrivé a faire ce que je voulais.
J'ai trouver un code qui fonctionne à peu près mais.
- Il est pour 1 seul Combobox et moi je le veux pour mes 4 Combobox.
- et quand je choisi un nom qui est déjà dans la liste, cela me fait un trou dans ma colonne.

Si une personne aurais une solution pour activer les 4 Combobox.

Ce que j'aimerais avoir.
J'ai 1 USF que j'utilise pour plusieurs feuilles.
Mon USF comporte 4 combobox.
Je rentre beaucoup de nom dans les 4 combobox
Au départ mes Combobox sont vide.
je voudrais que lorsque j'entre un nom, que cette entrée soit automatiquement rajouter à une liste pour des usages ultérieurs.
Les regroupés dans ma feuille "Accueil", tous les noms des 4 combobox dans une seule et même colonne à partir de BK1.

En attendant votre aide je vous remercie d'avance

Marcelio

marcelio · 23 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Re,

Personne ne peux m'aider à me trouver le code pour sauvegarder mes 4 Combobox.
SVP
Marcelio

fhoest · 23 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Bonjour,
voici ton code:

Code:

Option Explicit
Private Sub UserForm_Initialize()
Ini
End Sub
Private Sub Ini()
Dim l As Integer
Dim Plage As String

l = Sheets("Accueil").Range("BK65536").End(xlUp).Row
Plage = Sheets("Accueil").Range("BK1:BK" & l).Address
ComboBox1.RowSource = "Accueil!" & Plage

l = Sheets("Accueil").Range("BL65536").End(xlUp).Row
Plage = Sheets("Accueil").Range("BL1:BL" & l).Address
ComboBox2.RowSource = "Accueil!" & Plage

l = Sheets("Accueil").Range("BM65536").End(xlUp).Row
Plage = Sheets("Accueil").Range("BM1:BM" & l).Address
ComboBox3.RowSource = "Accueil!" & Plage

l = Sheets("Accueil").Range("BN65536").End(xlUp).Row
Plage = Sheets("Accueil").Range("BN1:BN" & l).Address
ComboBox4.RowSource = "Accueil!" & Plage

End Sub
Private Sub Cmd_Valider_Click()
Dim l As Integer
Dim i As Integer
Dim Nom As String
Nom = ComboBox1.Value
If Nom = "" Then GoTo ici:
        l = Sheets("Accueil").Range("BK65536").End(xlUp).Row + 1
        Sheets("Accueil").Range("BK" & l).Value = Nom
        Sheets("Accueil").Columns("BK").Sort Key1:=Range("BK1"), Order1:=xlAscending, Header:=xlGuess
        For i = Range("BK65536").End(xlUp).Row + 1 To 2 Step -1
        If Range("bk" & i) = Range("bk" & i - 1) Then
        Range("bk" & i).ClearContents
        End If
        Next
ici:
        On Error Resume Next
       Nom = ComboBox2.Value
If Nom = "" Then GoTo ici1:
        l = Sheets("Accueil").Range("BL65536").End(xlUp).Row + 1
        Sheets("Accueil").Range("BL" & l).Value = Nom
        Sheets("Accueil").Columns("BL").Sort Key1:=Range("BL1"), Order1:=xlAscending, Header:=xlGuess
        For i = Range("BL65536").End(xlUp).Row + 1 To 2 Step -1
        If Range("bL" & i) = Range("bL" & i - 1) Then
        Range("bL" & i).ClearContents
        End If
        Next
ici1:
        
        On Error Resume Next
       Nom = ComboBox3.Value
If Nom = "" Then GoTo ici2:
        l = Sheets("Accueil").Range("BM65536").End(xlUp).Row + 1
        Sheets("Accueil").Range("BM" & l).Value = Nom
        Sheets("Accueil").Columns("BM").Sort Key1:=Range("BM1"), Order1:=xlAscending, Header:=xlGuess
        For i = Range("BM65536").End(xlUp).Row + 1 To 2 Step -1
        If Range("bM" & i) = Range("bL" & i - 1) Then
        Range("bM" & i).ClearContents
        End If
        Next
ici2:
        
        On Error Resume Next
       Nom = ComboBox4.Value
If Nom = "" Then GoTo ici3:
        l = Sheets("Accueil").Range("BN65536").End(xlUp).Row + 1
        Sheets("Accueil").Range("BN" & l).Value = Nom
        Sheets("Accueil").Columns("BN").Sort Key1:=Range("BN1"), Order1:=xlAscending, Header:=xlGuess
        For i = Range("BN65536").End(xlUp).Row + 1 To 2 Step -1
        If Range("bN" & i) = Range("bN" & i - 1) Then
        Range("bN" & i).ClearContents
        End If
        Next
ici3:
        Ini
           
    Unload Me
End Sub

A+

marcelio · 24 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Bonjour le Forum,
Bonjour fhoest,

Merci pour ce code qui fonctionne super bien.
Mais il y à toujours le problème, que quand je choisi un nom qui est déjà dans la liste, cela me fait un trou dans ma colonne.
Si vous avez une solution pour parer à cela.

Merci beaucoup de votre aide.

Bonne journée à vous et au Forum.

Marcelio

fhoest · 24 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Bonjour,
pour remédier au problème il faut refaire un tri comme ceci:

Code:

Private Sub Cmd_Valider_Click()
Dim l As Integer
Dim i As Integer
Dim Nom As String
Nom = ComboBox1.Value
If Nom = "" Then GoTo ici:
        l = Sheets("Accueil").Range("BK65536").End(xlUp).Row + 1
        Sheets("Accueil").Range("BK" & l).Value = Nom
        Sheets("Accueil").Columns("BK").Sort Key1:=Range("BK1"), Order1:=xlAscending, Header:=xlGuess
        For i = Range("BK65536").End(xlUp).Row + 1 To 2 Step -1
        If Range("bk" & i) = Range("bk" & i - 1) Then
        Range("bk" & i).ClearContents
        End If
        Next
        Sheets("Accueil").Columns("BK").Sort Key1:=Range("BK1"), Order1:=xlAscending, Header:=xlGuess
ici:
        On Error Resume Next
       Nom = ComboBox2.Value
If Nom = "" Then GoTo ici1:
        l = Sheets("Accueil").Range("BL65536").End(xlUp).Row + 1
        Sheets("Accueil").Range("BL" & l).Value = Nom
        Sheets("Accueil").Columns("BL").Sort Key1:=Range("BL1"), Order1:=xlAscending, Header:=xlGuess
        For i = Range("BL65536").End(xlUp).Row + 1 To 2 Step -1
        If Range("bL" & i) = Range("bL" & i - 1) Then
        Range("bL" & i).ClearContents
        End If
        Next
        Sheets("Accueil").Columns("BL").Sort Key1:=Range("BL1"), Order1:=xlAscending, Header:=xlGuess
ici1:
       
        On Error Resume Next
       Nom = ComboBox3.Value
If Nom = "" Then GoTo ici2:
        l = Sheets("Accueil").Range("BM65536").End(xlUp).Row + 1
        Sheets("Accueil").Range("BM" & l).Value = Nom
        Sheets("Accueil").Columns("BM").Sort Key1:=Range("BM1"), Order1:=xlAscending, Header:=xlGuess
        For i = Range("BM65536").End(xlUp).Row + 1 To 2 Step -1
        If Range("bM" & i) = Range("bL" & i - 1) Then
        Range("bM" & i).ClearContents
        End If
        Next
        Sheets("Accueil").Columns("BM").Sort Key1:=Range("BM1"), Order1:=xlAscending, Header:=xlGuess
ici2:
       
        On Error Resume Next
       Nom = ComboBox4.Value
If Nom = "" Then GoTo ici3:
        l = Sheets("Accueil").Range("BN65536").End(xlUp).Row + 1
        Sheets("Accueil").Range("BN" & l).Value = Nom
        Sheets("Accueil").Columns("BN").Sort Key1:=Range("BN1"), Order1:=xlAscending, Header:=xlGuess
        For i = Range("BN65536").End(xlUp).Row + 1 To 2 Step -1
        If Range("bN" & i) = Range("bN" & i - 1) Then
        Range("bN" & i).ClearContents
        End If
        Next
        Sheets("Accueil").Columns("BN").Sort Key1:=Range("BN1"), Order1:=xlAscending, Header:=xlGuess
ici3:
        Ini
           
    Unload Me
End Sub

A bientôt.

marcelio · 24 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Bonjour,

Merci fhoest c'est super tout est correct.
Je vous remercie une nouvelle fois.

Bon après midi à vous et au forum.
A+
Marcelio

marcelio · 24 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Bonsoir le forum,
Bonsoir fhoest,

Étant donnés que je travail sur plusieurs feuilles avec le même USF.
J'ai un message d'erreur quand je ne suis pas sur la feuille "Accueil".

Erreur d'exécution '1004':
Référence de tri non valide. Vérifier qu'elle se trouve bien parmi les données à trier et que la zone Trier par n'est pas identique ou vide.

et surligné en jaune :
Sheets("Accueil").Columns("BK").Sort Key1:=Range("BK1"), Order1:=xlAscending, Header:=xlGuess

Merci de nouveau de votre aide

Bonne soirée

Marcelio

fhoest · 24 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Bonsoir
mettre l'instruction en début de code

Code:

Sheets("Accueil").activate

Ensuite en fin de code voir pour mettre l'autre feuille active si nécessaire pour connaitre la feuille active au moment du clique sur le bouton afin de revenir sur la bonne feuille il faut passer par une variable.
exemple:
début de code

Code:

dim sh as string
sh =activesheets.name
Sheets("Accueil").activate
'ton code ....
Sheets(sh).activate 'pour revenir sur la bonne feuille

A+ (tu peux me tutoyer pas de problème)

marcelio · 24 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Re,

Merci de ton aide mais j'ai encore un bug:
Erreur de compilation:
Variable non définie

et en gras bleu : activesheets

A+

fhoest · 24 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

bonsoir
enlève le s
A+

marcelio · 24 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Re,

Tout fonctionne mais je retourne sur ma feuille "Accueil".
Et comme j'ai plusieurs feuille quel code je doit mettre pour rester sur la feuille ou je suis

Sheets("Accueil").activate
'ton code ....

A+

fhoest · 24 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Re,
comme ceci ton fichier en retour avec le bon code
A+

Si... · 25 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Salut

autre proposition -avec message- à tester.

marcelio · 25 Avril 2014

Re : Sauvegarder automatiquement les données de mes 4 combobox

Bonjour le forum,
Bonjour fhoest et Si...

Merci fhoest ton dernier fichier est super et j'ai rencontré aucun bug.
Si... je vais regarder ton fichier, mais pour l'instant je garde celui de fhoest.

Merci à tous les 2 et bonne journée à vous et au forum.

A+
Marcelio

Effectuez une recherche sur Excel Downloads...

Sauvegarder automatiquement les données de mes 4 combobox

marcelio

XLDnaute Occasionnel

Pièces jointes

marcelio

XLDnaute Occasionnel

fhoest

XLDnaute Accro

marcelio

XLDnaute Occasionnel

fhoest

XLDnaute Accro

marcelio

XLDnaute Occasionnel

marcelio

XLDnaute Occasionnel

fhoest

XLDnaute Accro

marcelio

XLDnaute Occasionnel

fhoest

XLDnaute Accro

marcelio

XLDnaute Occasionnel

fhoest

XLDnaute Accro

Pièces jointes

Si...

XLDnaute Barbatruc

Pièces jointes

marcelio

XLDnaute Occasionnel

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums