Code simple et léger pour incrémenter des cellules à partir de TextBox

Bonjour à tous,
Je fais un programme dans lequel plusieurs textBoxs d'une même Userform recoivent la saisie de données qui doivent, en cliquant sur un bouton, aller incrémenter les cellules d'une même ligne.
TextBox1 va dans A1 de la feuille 1
TextBox2 va dans B1 de la feuille 1
TextBox3 va dans C1 de la feuille 1
etc...

Pour l'instant, je procède comme suit :

Code:

---

1 2 3 4 5 6 7

Private Sub CommandButton1_Click() Application.ScreenUpdating = False ActiveSheet.Unprotect Sheets("Feuil1").Range("A1") = TextBox1 Sheets("Feuil1").Range("B1") = TextBox2 Sheets("Feuil1").Range("C1") = TextBox3 End Sub

---

Mais cela allourdit considérablement le fichier, surtout que j'ai 234 TextBoxs.

Je sais qu'il est possible d'aboutir au même résultat avec un code bien plus simple mais je ne sais pas vers quelle(s) fonction(s) m'orienter.

Quelqu'un pourrait-il m'orienter svp pour que j'apprenne et que je comprenne comment faire ?

Merci par avance à ceux qui voudront m'épauler.

Laurent

Bonjour,

Une solution consiste à boucler sur tous les objets de ta userform, de tester le type de chaque objet, et quand on trouve une texbox, on ajoute dans l'onglet excel

Code:

---

1 2 3 4 5 6 7 8 9

Dim Ctl As Control   For Each Ctl In UserForm1.Controls If TypeOf Ctl Is MSForms.TextBox Then 'Ajoute dans l'onglet   End If   Next

---

http://silkyroad.developpez.com/VBA/...ables/#LVIII-C

Bonjour Jérome et merci pour ta réponse.

Je vois que tu as mis une annotation 'Ajoute dans l'onglet et je crois comprendre qu'à la place il faut dire au code qu'il doit aller incrémenter la cellule A1 avec les données de la TextBox1 et pareil pour toutes les suivantes mais là je suis perdu.
Aurais-tu une idée?

En tout cas merci beaucoup.

Laurent

bonsoir
attention

la boucle que t'a proposé j fontaine fonctionne parfaitement a condition que les textboxs aient été mis en place dans le bon ordre
sinon c'est la catastrophe
alors ca représente un boulot supplémentaire mais néanmoins efficace
dans le tag de tes textbox met l'adresse de la cellule correspondante
et dans ta boucle

Code:

---

1 2 3

for each ctrl in me .controls if typename(ctrl)="Textbox" then range(ctrl.tag)=ctrl next

---

au plaisir

Bonsoir Patrick et merci,

Non seulement ça fonctionne mais en plus j'ai compris.
J'ai juste une question.
Ce code incrémente-t-il obligatoirement la ligne 1 de la feuille ?
Je ne vois pas comment faire pour aller incrémenter les cellules de la ligne 2 ou autre

Sinon, merci d'avoir passé du temps à me répondre et m'aider.

J'ai maintenant un autre petit soucis mais je crois que celà fera l'objet d'un autre poste pour attirer l'oeil de plus de gens qui seraient à même de me répondre. Je te le propose quand même :

J'ai créé une userform avec un multipage de 2 pages.
Sur la premiere, 14 textbox dans lesquelles je saisie des information sur un écrivain (nom, prénom, etc...) et sur la seconde page, 10 Textbox dans lesquelles je saisie le titre d'un ouvrage, sa date de parution, etc...
En cliquant sur un bouton de la userform, j'envoie ces information dans les cellules de la ligne 1 (A1, B1, C1, etc...) de la feuille 1 en utilisant le code que tu m'as expliqué, à savoir :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Sub Incrementer1() Dim Ctrl As Control   For Each Ctrl In CréationFiche.Controls If TypeName(Ctrl) = "TextBox" Then Range(Ctrl.Tag) = Ctrl ' '... '   Next Ctrl   End Sub

---

Ensuite, j'archive les informations de cette ligne dans la feuille 2 pour générer une sorte de base de données en utilisant le code suivant :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38

Sub Archiver(ByVal Ligne) Dim ligneHisto Dim col Dim colHisto   ligneHisto = TrouverLigneVide colHisto = 1   'Recopie des valeurs de la ligne dans la feuille d'historique For col = 1 To 252 If col <> 253 Then Sheets("Feuil2").Cells(ligneHisto, colHisto).Value = ActiveSheet.Cells(Ligne, col).Value colHisto = colHisto + 1 End If Next   'Suppression des valeurs de la ligne For col = 1 To 252 If col <> 253 Then ActiveSheet.Unprotect ActiveSheet.Cells(Ligne, col).Value = "" ActiveSheet.Protect End If Next   End Sub   Function TrouverLigneVide() Dim Ligne   Ligne = 2   Do While Sheets("Feuil2").Cells(Ligne, 1).Value <> "" Ligne = Ligne + 1 Loop   TrouverLigneVide = Ligne End Function

---

Comme tu peux le voir dans le code ci-dessus, j'en profite pour, une fois archées, effacer les données de la ligne 1 de la feuille 1.
Jusque là, j'ai crée une fiche au nom d'un auteur et les informations sur le premier ouvrage qu'il a écrit.
Par la suite, je peux avoir à ajouter un second ouvrage dans sa fiche, voir plusieur, jusqu'à 22.
J'ai donc crée un autre userform composée de 234 textbox.
Lorsque j'ouvre cette nouvelle userform, j'e vais chercher les données qui concernent l'auteur de la manière suivante :
D'abord je lance une userform composée d'une listbox (ModificationDe) qui fait référence à la liste de tous les écrivain déjà présent dans ma base.
Ensuite, je vais chercher ce nom dans la feuille2 pour en sélectionner la ligne de la facon suivante :

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub Chercher_Ligne() Application.ScreenUpdating = False Sheets("Feuil2").Select Dim Nom_ok As Range Set Nom_ok = Columns("A").Find(ModificationDe.ListBox1) If Nom_ok Is Nothing Then AuteurInconnu.Show Else Nom_ok.EntireRow.Select End If End Sub

---

Une fois fait, je transfère les données de cette ligne dans les cellule de la ligne 1 grace à la manipulation suivante :

Code:

---

1 2 3 4 5 6 7 8 9 10

Sub Transfert() ' '   ' Selection.Copy Sheets("Feuil1").Select Range("A1").Select ActiveSheet.Paste End Sub

---

Puis j'ouvre la userform de 234 textbox (ModifierCompléterFiche) que j'ai citéé plus haut. Les informations déja saisies dans la fiche de l'auteur s'affichent dans chacune de ses textbox comme ceci :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Private Sub UserForm_Activate() Label261 = Sheets("Feuil1").Range("IR1") End Sub   Private Sub UserForm_Initialize() Dim sht As Worksheet Set sht = ThisWorkbook.Worksheets("Feuil1") Dim c As Integer For c = 1 To 234 Me.Controls("TextBox" & c) = sht.Cells(1, c) Next c End Sub

---

Jusque là, tout baigne.
J'ai ensuite duppliqué le code que tu m'as expliqué pour reporter les saisies des texbox de cette userform (ModifierCompléterFiche) de la manière suivante :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Sub Incrementer2() Dim Ctrl As Control   For Each Ctrl In CompléterModifierFiche.Controls If TypeName(Ctrl) = "TextBox" Then Range(Ctrl.Tag) = Ctrl ' '... '   Next Ctrl   End Sub

---

C'EST Là QUE SURVIENT LE PROBLEME !!!

Ensuite, je vais supprimer la ligne qui contient les données de cette auteur dans la feuille 2 qui constitue ma base de données pour éviter que lors de l'archivage celà constitue une seconde ligne pour un même auteur en agissant comme celà :

Code:

---

1 2 3 4 5 6 7 8

Sub Supprimer2() Application.ScreenUpdating = False Sheets("Feuil2").Select Cells.Find(What:=CompléterModifierFiche.TextBox1, After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.EntireRow.ClearContents End Sub

---

Puis je relance l'archivage comme ceci en lancant le code Archiver déja utilisé plus haut puis je lance un tri alphabétique.

Donc, lorsque je clique sur un bouton qui lance Incrémenter2, j'ai le message suivant : La méthode 'Range' de l'objet '_Global' a échouée.

Et forcément je ne comprend pas pourquoi !!!
Si celà te parle, je suis preneur :lol:
Si tu le désir, je peux te joindre mon fichier car mais explications sont longue et peut-être pas tres parlante comme ça.

Et bien sur, je suis open à toutes propositions de quiconque -))

Merci à toi si tu te penches sur le sujet et aussi à ceux qui voudront s'y joindre.

Laurent

bonjour
pour ton 2 eme soucis je te propose de faire autrement

dans ton userform ajoute une page a ton multipage pourquoi pas

dans cet page un combobox et les textboxs nécessaires

et un bouton (valider )

le combobox se remplira avec les noms des auteurs (pas tres difficiles)

au click du bouton utiliser la fonction native (find) sur le nom sélectionné dans la combobox

un fois la ligne trouvée, repérer la dernière colonne utilisée pour les livres
ajouter 1 et inscrire ce qu'il y a dans le textboxs

voila médite la dessus

au plaisir

Bonsoir Patrick, je te remercie beaucoup pour ce sacré coup de pouce.
C'est vraiment sympa de m'avoir consacré du temps.
Je vais me pencher sur cette solution à laquelle je n'avais pas pensé.
Bonne continuation à toi.
Laurent