XL 2013 VBA Userform remplir plusieurs lignes selon criteres

call911 · 12 Octobre 2016

Bonjour,

Je souhaite utiliser un Userform pour remplir les données d'un tableau.
Sur ce Userform, je voudrais pouvoir reprendre des informations saisies une seule fois mais le répliquer sur plusieurs lignes.

Sur l'exemple,
Je voudrais remplir sur chaque ligne du tableau excel Action Matiere Qté en reprenant le nom du client et le tel saisis sur la première ligne du formulaire sur chacune des lignes concernées.

Pour le moment mon code donne ça

Code:

Private Sub Ajouter_Click()
    Dim i As Integer 'Declaration de variable comme entier
    'RENDRE CHAMP OBLIGATOIRE Verifier que tous les champs ont bien été remplis
    If AjoutDossier.TxbClient = "" Or AjoutDossier.TxbTel = "" Then
    MsgBox "Merci de remplir tous les champs"
   
    Else 'VERIFIER PROCHAINE CELLULE LIBRE.
        i = 1 'la variable i est = a 2, car le tableau commence en 2eme ligne
        Do While Cells(i, 1) <> "" 'Dès le clic sur ajouter, recherche cell different de nul  dans col 1 cell 1 du tableau qui commence en ligne 2
        Cells(i, 1).Offset(1, 0).Select 'se deplacer d'une ligne sur la meme colonne
        i = i + 1 'On incrémente la variable i de 1
        Loop
       
        'ActiveCell.Value = Ajoutclient.Nom.Value 'remplir la cellule active, ce qui n'est pas le cas, on doit se déplacer
        ActiveCell.Offset(0, 5).Value = AjoutDossier.TxbClient
        ActiveCell.Offset(0, 7).Value = AjoutDossier.TxbTel
        ActiveCell.Offset(0, 52).Value = AjoutDossier.CbxAction
        ActiveCell.Offset(0, 53).Value = AjoutDossier.CbxMatiere
        ActiveCell.Offset(0, 55).Value = AjoutDossier.TxbQte
       
        ActiveCell.Offset(0, 52).Value = AjoutDossier.CbxAction2
        ActiveCell.Offset(0, 53).Value = AjoutDossier.CbxMatiere2
        ActiveCell.Offset(0, 55).Value = AjoutDossier.TxbQte2
       
        'Unload Ajoutclient Pour le moment je ne l'active pas
    End If
   
End Sub

Private Sub Annuler_Click()
    'Pour que lorsque l'on fait annuler sur le formulaire, il n'efface pas les infos déja saisies
    AjoutDossier.Hide
   
End Sub

Private Sub UserForm_Click() 'creation procedure evenementielle sur le formulaire

End Sub
Private Sub UserForm_Initialize() 'pour charger les données d'Actions dès que j'appelle le formulaire
    Dim i As Integer 'declaration de la variable
    i = 2 'initialisation de la variable
    'cells est un peu comme range, i de la variable en ligne 1 donc A1
    Do While Worksheets("Nomenclature").Cells(i, 2) <> "" 'cells i=1 donc première ligne, 1 pour la colonne
        CbxAction.MatchRequired = True
        CbxAction.AddItem Worksheets("Nomenclature").Cells(i, 2)
        'incrémentation de la variable
        i = i + 1
    Loop
    i = 2
    'cells est un peu comme range, i de la variable en 1 ligne donc A1
    Do While Worksheets("Nomenclature").Cells(i, 1) <> "" 'cells i=1 donc première ligne, 1 pour la colonne
        CbxMatiere.MatchRequired = True
        CbxMatiere.AddItem Worksheets("Nomenclature").Cells(i, 1)
        'incrémentation de la variable
        i = i + 1
    Loop
   
    i = 2
    'cells est un peu comme range, i de la variable en 1 ligne donc A1
    Do While Worksheets("Nomenclature").Cells(i, 2) <> "" 'cells i=1 donc première ligne, 1 pour la colonne
        CbxAction2.AddItem Worksheets("Nomenclature").Cells(i, 2)
        'incrémentation de la variable
        i = i + 1
    Loop
    i = 2
    'cells est un peu comme range, i de la variable en 1 ligne donc A1
    Do While Worksheets("Nomenclature").Cells(i, 1) <> "" 'cells i=1 donc première ligne, 1 pour la colonne
        CbxMatiere2.AddItem Worksheets("Nomenclature").Cells(i, 1)
        'incrémentation de la variable
        i = i + 1
    Loop
   
   
End Sub

Merci.

bbb38 · 12 Octobre 2016

Bonsoir call911, le forum,
Une solution, mais avec une autre méthode (non testée, car pas de fichier d’exemple).
Je pense qu’il y a plus simple.
Cordialement,
Bernard

Code:

Private Sub Ajouter_Click()

' Declaration des variables
Dim i As Integer

‘ On suppose que tous les cases ne sont pas obligatoirement complétées.

‘ Sauf le nom et le prénom du client, une action accompagnée de la matière et de la quantité.

If AjoutDossier.TxbClient = "" Or AjoutDossier.TxbTel = "" Or AjoutDossier.CbxAction = "" Or _

  AjoutDossier.CbxMatiere =  "" Or AjoutDossier.TxbQte  = "" Then

    MsgBox "Merci de remplir tous les champs"

  AjoutDossier.TxbClient .SetFocus

   Exit Sub

End If

‘ On recherche la dernière ligne libre

  With Sheets("Nom de la feuille")  ‘ indiquer le nom de la feuille

  i = .Range("A" & Rows.Count).End(xlUp).Row + 1

  .Cells(i, 5) = AjoutDossier.TxbClient

     .Cells(i, 7) = AjoutDossier.TxbTel

    .Cells(i, 52) = AjoutDossier.CbxAction

    .Cells(i, 53) = AjoutDossier.CbxMatiere

    .Cells(i, 55) = AjoutDossier.TxbQte

  ‘ Pas de vérification pour le remplissage des cases suivantes

  If  AjoutDossier.CbxAction2 <> "" Then

  i = i + 1

    .Cells(i, 5) = AjoutDossier.TxbClient

    .Cells(i, 7) = AjoutDossier.TxbTel

    .Cells(i, 52) = AjoutDossier.CbxAction2

    .Cells(i, 53) = AjoutDossier.CbxMatiere2

  .Cells(i, 55) = AjoutDossier.TxbQte2

  End If

  If  AjoutDossier.CbxAction3 <> "" Then

  i = i + 1

  .Cells(i, 5) = AjoutDossier.TxbClient

    .Cells(i, 7) = AjoutDossier.TxbTel

    .Cells(i, 52) = AjoutDossier.CbxAction3

    .Cells(i, 53) = AjoutDossier.CbxMatiere3

    .Cells(i, 55) = AjoutDossier.TxbQte3

  End If

  If  AjoutDossier.CbxAction4 <> "" Then

  i = i + 1

  .Cells(i, 5) = AjoutDossier.TxbClient

     .Cells(i, 7) = AjoutDossier.TxbTel

    .Cells(i, 52) = AjoutDossier.CbxAction4

    .Cells(i, 53) = AjoutDossier.CbxMatiere4

    .Cells(i, 55) = AjoutDossier.TxbQte4

End If

Exit Sub

call911 · 13 Octobre 2016

Bonsoir,

Merci pour la réponse et pour ton aide.

Je tente de mettre en place le code que tu me proposes, mais je suis trop débutant pour y arriver visiblement

Lorsque je valide la saisie dans le Userform, il bloque sur
i = .Range("A" & Rows.Count).End(x1Up).Row + 1
Visiblement c'est le (x1Up) qui pose problème.

Du coup, je me suis rendu compte que la définition des cellules venant d'un autre tableau (celui sur lequel j'essaie de mettre en place le formulaire de saisie) étaient fausses.
J'ai essayé de les corriger.
Du coup, je m'interroge.
En fait, ce que je ne comprends pas, c'est que visiblement la variable i est déclarée comme range.
Sur les tutos que j'ai vu, j'avais cru comprendre qu'il faudrait pointer sur les cellules avec définition de la plage si on utilise la notion de Range?
(en fait, j'essaie de comprendre la difference sur les histoire de cells et range, qui sont encore tres floues pour moi)

Je te joins le fichier.

call911 · 13 Octobre 2016

Bonjour,

J'ai oublié d'insérer le code.

Code:

Private Sub Ajouter_Click()
    Dim i As Integer 'Declaration de variable comme entier
    'RENDRE CHAMP OBLIGATOIRE Verifier que tous les champs ont bien été remplis
    'On suppose que tous les cases ne sont pas obligatoirement complétées.
    'Sauf le nom et le prénom du client, une action accompagnée de la matière et de la quantité.
   
    If AjoutDossier.TxbClient = "" Or AjoutDossier.TxbTel = "" Or AjoutDossier.CbxAction = "" Or AjoutDossier.CbxMatiere = "" Then
    MsgBox "Merci de remplir tous les champs"
    AjoutDossier.TxbClient.SetFocus
   
    Exit Sub
   
    End If
   
    'On recherche la dernière ligne libre
    With Sheets("Planning")
    i = .Range("A" & Rows.Count).End(x1Up).Row + 1
    .Active Cells(i, 0) = AjoutDossier.TxbClient
    .Cells(i, 1) = AjoutDossier.TxbTel
    .Cells(i, 2) = AjoutDossier.CbxAction
    .Cells(i, 3) = AjoutDossier.CbxMatiere
    .Cells(i, 4) = AjoutDossier.TxbQte

  'Pas de vérification pour le remplissage des cases suivantes
   
    If  AjoutDossier.CbxAction2 <> "" Then
    i = 1 + 1
    .Active Cells(i, 0) = AjoutDossier.TxbClient
    .Cells(i, 1) = AjoutDossier.TxbTel
    .Cells(i, 2) = AjoutDossier.CbxAction2
    .Cells(i, 3) = AjoutDossier.CbxMatiere2
    .Cells(i, 4) = AjoutDossier.TxbQte2
   
    End If
   
    If  AjoutDossier.CbxAction3 <> "" Then
    i = i + 1
    .Active Cells(i, 0) = AjoutDossier.TxbClient
    .Cells(i, 1) = AjoutDossier.TxbTel
    .Cells(i, 2) = AjoutDossier.CbxAction3
    .Cells(i, 3) = AjoutDossier.CbxMatiere3
    .Cells(i, 4) = AjoutDossier.TxbQte3

    End If

    If  AjoutDossier.CbxAction4 <> "" Then
    i = i + 1
    .Active Cells(i, 0) = AjoutDossier.TxbClient
    .Cells(i, 1) = AjoutDossier.TxbTel
    .Cells(i, 2) = AjoutDossier.CbxAction4
    .Cells(i, 3) = AjoutDossier.CbxMatiere4
    .Cells(i, 4) = AjoutDossier.TxbQte4

    End If

End Sub

bbb38 · 14 Octobre 2016

Bonsoir call911, le forum,
Pour éviter de créer 8 Combobox, j’ai utilisé 2 Combobox (action et matière). Avantage : on peut insérer 1 ou plusieurs dossiers pour le même client (sur le formulaire, on peut mettre un compteur pour indiquer le nombre de dossiers créés).
Pour les clients, j’ai prévu une Combobox, dans l’hypothèse, ou l’on souhaite créer une nomenclature Clients (valable, si un client revient plusieurs fois).
Si les actions et les matières ne sont pas trop nombreuses, on peut changer les ComboBox pour des ListBox.
A tester (risque d’erreurs, car j’ai repris les codes de plusieurs fichiers en ma possession).
Si tu souhaites, revenir à ton formulaire initial, je modifierai les codes.
Cordialement,
Bernard

Lone-wolf · 14 Octobre 2016

Bonjour call, bbb

Pour inserer ligne par ligne, il faut faire comme ceci: lig = .Range("a65536").end(xlUp).Row + 1 : .Cells(lig, 1) = TxbClient.

Plus rapide: dans les propriétés Tag des contrôles tu inscrit le numéro de la colonne. Exemple: 1 = colonne A - 2 =colonne B - 3 = colonne C etc. Ensuite un exemple:

VB:

Private Sub CommandButton1_Click() 'Bouton Enregistrements
Dim col As long,  lig As long,  ctrl As Control

For Each ctrl In Me.Controls
If ctrl.value = "" Then MsgBox "Merci de remplir tous les champs"

If  TypeName(Ctrl) = "ComboBox"  Then
col = Val(ctrl.Tag)
If col > 0 Then Sheets("Planning").Cells(lig, col) = ctrl
End if
Next ctrl

With Sheets("Planning")
lig = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lig, 1) = TxbTel
.Cells(lig, 4) = TxbQte
End With

Staple1600 · 14 Octobre 2016

Bonjour à tous

Juste pour éviter de potentiels déboires, préférez
Dim col As Long, derlig As Long

Lone-wolf · 14 Octobre 2016

Bonjour JM

C'est vrai, tu as raison. Long ayant une bien plus grande valeur qu'Integer. Je corrige de ce pas.

Staple1600 · 14 Octobre 2016

Bonjour Lone-Wolf

On peut aussi pour s'affranchir des versions Excel, utiliser plutôt:
lig = .Cells(Rows.Count,1).End(xlUp).Row + 1
ou selon les préfénce d'écriture
lig = .Range("A" & Rows.Count).End(xlUp).Row + 1

Lone-wolf · 14 Octobre 2016

Re JM

Comme je sais que tu scrupte la plupart des messages (comme un moderateur ),
tu peux m'appeler Dodo, key?

call911 · 14 Octobre 2016

Bonjour,

Un grand merci à vous trois pour votre aide.

bbb18, la solution que tu proposes me va également bien, puisqu'elle permettra de remplir plusieurs lignes de dossier pour un meme client.
Je vais donc la mettre en place sur mon fichier définitif qui comprend beaucoup plus de cases à remplir.

Par contre, tu proposes d'utiliser une listebox au lieu d'un combobox si il n'y a pas trop de lignes. Mais pas beaucoup, ça fait combien environ ? Ma liste de produits va être longue (pour le moment 200 lignes, mais c'est en augmentation continue)
Pour les action, j'en ai environ 50.

Par contre, Lone Wolf, je suis désolé, mais je ne comprends pas tres bien ce que tu veux dire.
Est ce que c'est une alternative à cette partie du code?

Code:

      Private Sub Cmd_ajouter_Click()
      ' bouton de commande - Ajouter les mouvements
      ' Verifier que tous les champs ont bien été remplis - ComboBox1 = Clients - ComboBox2 = Actions - ComboBox3 = Matières -
      If ComboBox1 = "" Or TxbTel.Text = "" Or ComboBox2 = "" Or ComboBox3 = "" Or TxbQte = "" Then
            MsgBox "Merci de remplir tous les champs.", vbExclamation, TitreMsg
            AjoutDossier.ComboBox2.ListIndex = 0: AjoutDossier.ComboBox3.ListIndex = 0
            AjoutDossier.ComboBox1.SetFocus
            Exit Sub
      End If
      ' enregistrment des mouvements
      With Sheets("Planning")
            i = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' On affecte le no de la dernière ligne libre à la variable i
            .Cells(i, 1) = AjoutDossier.ComboBox1
            .Cells(i, 2) = AjoutDossier.TxbTel.Text
            .Cells(i, 3) = AjoutDossier.ComboBox2
            .Cells(i, 4) = AjoutDossier.ComboBox3
            .Cells(i, 5) = CLng(AjoutDossier.TxbQte)
      End With

Ou bien c'est une solution qui est valable pour le Userform avec plusieurs lignes que je voulais faire au début?

Encore merci à vous trois pour votre support.

Lone-wolf · 15 Octobre 2016

Bonjour Call,

c'est bien une alternative. Si tu regarde ton code, tu répète à plusieures reprises Si X est vide ou Y est Vide ou Z est vide alors... . Tandis que le code que j'ai montré, se lit une fois pour tous les contrôles. Comme tu part du formulaire, il n'y a pas besoin d'ajouter son nom (AjoutDossier). Inutile aussi de mettre 4 textbox pour la quantité, une suffit.

Une correction à apporter à ton code, selon les conseils de Stapple. Tu as écrit i = .Range("A" & Rows.Count), il faut le changer par i = .Cells(Rows.Count, 1), vu qu'après tu écrit .Cells(i, 1) .

En écrivant .Range("A" & Rows.Count) , il faut ensuite écrire: .Range("a" & i) - .Range("b" & i) etc.

J'ai corrigé le code que je t'ai montré.

VB:

Private Sub CommandButton1_Click() 'Bouton Enregistrements
Dim col As long,  lig As long,  ctrl As Control

lig = Sheets("Planning").Cells(Rows.Count, 1).End(xlUp).Row + 1

For Each ctrl In Me.Controls
If ctrl.value = "" Then MsgBox "Merci de remplir tous les champs"

With Sheets("Planning")
If  TypeName(ctrl) = "ComboBox"  Then
col = Val(ctrl.Tag)
If col > 0 Then .Cells(lig, col) = ctrl
End if
Next ctrl

.Cells(lig, 1) = TxbTel
.Cells(lig, 4) = TxbQte
End With
End Sub

bbb38 · 17 Octobre 2016

Bonsoir call911, le forum,
Pour ma part, si la ListBox fait apparaître 40 lignes, le maximum serait de 80 lignes (soit le double de lignes). Par contre, on peut utiliser des Combobox avec saisie intuitive (permet d’obtenir la liste des items au fur et à mesure de la frappe des caractères - Site Jacques BOISGONTIER). J’essaie d’adapter cette méthode à ton fichier.

Bonsoir Lone-Wolf, Staple1600,
Merci pour votre participation. Jusqu’à présent, j’utilisai la boucle « For Each ctrl In Me Controls », uniquement pour effacer le contenu des contrôles. Je vais donc étudier cette proposition.

Cordialement,
Bernard

call911 · 22 Octobre 2016

Bonsoir à tous,

Encore une fois merci à tous pour votre support.
Comme c'est la première fois que je me lance dans du VBA, j'ai passé pas mal de temps sur les forum pour mieux comprendre vos commentaires, d'où le temps de réaction à vos posts. Du coup j'ai réalisé que excel, est vraiment plus que puissant, et avec VBA, c'est juste méga puissant

Je re contextualise:
En fait, je cherche à développer un formulaire de saisie, afin que des utilisateurs puissent générer des dossiers de production.
J'ai donc travaillé sur la proposition de Bernard (merci encore car elle est celle qui m'est le plus accessible.
Par contre, j'ai essayé d'appliquer l'alternative de Lone Wolf, mais je n'y arrive pas ...

De la, une question:
Est ce que l'une ou l'autre solution va plus vite en traitement?
En effet, je souhaite insérer ce formulaire pour remplir un tableau qui est beaucoup plus gros (82 colonnes, et pour le moment un peu plus de 9000 lignes) donc je me demande si une fois appliqué, ça ne sera pas trop lent et traitement.

Lone wolf, est ce que tu peux me dire ou est ce que ce code s'insère dans l'exemple de Bernard? j'ai bien essayé plusieurs fois, mais visiblement il y a quelque chose qui m'échappe, car à chaque fois ça part en vrille...

Concernant les texte box ou combobox, sur celle des matières, je vais avoir bien plus de 100 lignes, et potentiellement 1200 lignes. Donc, je suis intéressé par la notion de saisie intuitive (meme si pour le moment, ce n'est pas ma priorité... quand j'en serai à régler ce genre de détails, c'est que j'aurai déjà bien avancé)

Pour ce qui est de la proposition de Stapple 1600, j'ai essayé plusieurs fois de l'intégrer dans la partie de mon code, mais à chaque fois que je teste, ça marche pas, donc je suis resté sur

Code:

Dim i As Long, j As Long                  ' Déclaration des variables numériques
Dim plage As Range                        ' Déclaration des variables Objet

Ci joint le fichier

Une dernière question de débutant
J'ai souvent des problèmes pour que le code soit bien écrit.
Par exemple, sur la partie
lig = .Cells(Rows.Count,1).End(xlUp).Row + 1
Visiblement le End(x1Up) n'étais pas activé.
J'ai du m'y reprendre à de très nombreuses fois pour que ça le prenne en compte.
Est ce qu'il y a un moyen de savoir par exemple que le (x1Up) n'est pas bon quand on le tape, au lieu d'avoir à la taper et le lancer f5?
j'ai au début fait un copier collé, mais ensuite j'ai du retaper le code pas à pas plusieurs fois avant que ça marche.
En fait, pour certaines actions, VBA montre qu'il a pris en compte en ajoutant les majuscules, ou en ouvrant la parenthèse et propose qq chose, mais a priori pour certaines expressions, il ne signale rien comme par exemple le (x1Up), ou encore quand on met le nom d'une feuille avec des guillemets ("lenomdelafeuille"). Est ce normal?

XL 2013 VBA Userform remplir plusieurs lignes selon criteres

call911

XLDnaute Occasionnel

bbb38

XLDnaute Accro

call911

XLDnaute Occasionnel

Pièces jointes

call911

XLDnaute Occasionnel

bbb38

XLDnaute Accro

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

call911

XLDnaute Occasionnel

Lone-wolf

XLDnaute Barbatruc

bbb38

XLDnaute Accro

call911

XLDnaute Occasionnel

Pièces jointes

Discussions similaires