Simplification code

[vmax67]

Bonjour

je cherche à simplifier un code concernant un transfert de textbox vers une feuille.

Private Sub B_transfert_Click()
Dim DerLig As Integer
With Sheets("Sortie")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & DerLig) = T1
.Range("B" & DerLig) = T2
.Range("C" & DerLig) = T3
.Range("D" & DerLig) = TQS1
.Range("E" & DerLig) = TNST1
.Range("F" & DerLig) = T_date
.Range("G" & DerLig) = T_dem
.Range("H" & DerLig) = T_aff
DerLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & DerLig) = T4
.Range("B" & DerLig) = T5
.Range("C" & DerLig) = T6
.Range("D" & DerLig) = TQS4
.Range("E" & DerLig) = TNST4
.Range("F" & DerLig) = T_date
.Range("G" & DerLig) = T_dem
.Range("H" & DerLig) = T_aff
DerLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & DerLig) = T7
.Range("B" & DerLig) = T8
.Range("C" & DerLig) = T9
.Range("D" & DerLig) = TQS7
.Range("E" & DerLig) = TNST7
.Range("F" & DerLig) = T_date
.Range("G" & DerLig) = T_dem
.Range("H" & DerLig) = T_aff
DerLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & DerLig) = T10
.Range("B" & DerLig) = T11
.Range("C" & DerLig) = T12
.Range("D" & DerLig) = TQS10
.Range("E" & DerLig) = TNST10
.Range("F" & DerLig) = T_date
.Range("G" & DerLig) = T_dem
.Range("H" & DerLig) = T_aff
DerLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
End With
Unload Me
End Sub

Idem pour le changement de focus
Private Sub T1_Change()
Me.TQS1.SetFocus
End Sub

Private Sub T4_Change()
Me.TQS4.SetFocus
End Sub

Private Sub T7_Change()
Me.TQS7.SetFocus
End Sub

Private Sub T10_Change()
Me.TQS10.SetFocus
End Sub

Private Sub T13_Change()
Me.TQS13.SetFocus
End Sub

Par avance merci

Vmax67
Private Sub T1_Change()
Me.TQS1.SetFocus
End Sub

Private Sub T4_Change()
Me.TQS4.SetFocus
End Sub

Private Sub T7_Change()
Me.TQS7.SetFocus
End Sub

Private Sub T10_Change()
Me.TQS10.SetFocus
End Sub

Private Sub T13_Change()
Me.TQS13.SetFocus
End Sub

 

[Lone-wolf]

Bonjour vmax

Tu as deux solutions. La 1ère est de rennomer les textbox's(TextBox1 - TextBox2 - TextBox3 etc.) puis

Dim Derlig As Long, i As Long

With Sheets("Sortie")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
for i  = 1 to 8          'Nombre de colonnes ou textbox's
.Cells(DerLig, i) = Controls("TextBox" & i)
Next i
End with

La 2ème un peu plus fastidieuse. Dans la propriété de la textbox tu as "Tag".
Pour la textbox 1 tu met 1 qui correspond à la colonne A. Pour la textbox 2 tu met 2 qui correspond à la colonne B et ainsi de suite. Ensuite

Dim ctrl As Control, derlig As long

With Sheets("Sortie")
  derlig = .Range("a" & rows.count).End(xlUp).Row + 1

  For Each ctrl In Me.Controls
  col = Val(ctrl.Tag)
  If col > 0 Then
  If Not IsNumeric(ctrl) Then
  .Cells(derlig, col) = ctrl
  Else
  .Cells(derlig, col) = CDbl(ctrl)  'format numérique simple ex: 3124
  End If
  End If
  Next ctrl
End With

Pour le focus. Clic droit sur le formulaire, ordre de tabulation et tu ordonne les textbox's; supprime les macros leur concernant. Tu peux mettre TextBox1.SetFocus dans Initilialize et dans le bouton d'enregistrement. Je te met un fichier exemple. Double-clique sur la feuille pour afficher le formulaire.

 

[Dranreb]

Bonjour.
Pour le 1er problème je dirais :

Private Sub B_transfert_Click()
Dim L As Long, T(1 To 4, 1 To 8)
For L = 1 To 4
   T(L, 1) = Me("T" & 3 * L - 2).Text
   T(L, 2) = Me("T" & 3 * L - 1).Text
   T(L, 3) = Me("T" & 3 * L - 0).Text
   T(L, 4) = Me("TQS" & 3 * L - 2).Text
   T(L, 5) = Me("TNST" & 3 * L - 2).Text
   T(L, 6) = CDate(t_date.Text)
   T(L, 7) = T_dem.Text
   T(L, 8) = T_aff.Text: Next L
With Sheets("Sortie")
   L = .Range("A" & Rows.Count).End(xlUp).Row + 1
   .[A:H].Rows(L).Resize(4).Value = T
   End With
Unload Me
End Sub

Et pour le second je ne vois pas de solution évidente surtout pour des SetFocus qui ne sont pas des méthodes des contrôles proprement dit mais de leur statut de membre de la collection Controls. Mais on peut peut être quand même le faire en les désignant comme ça justement, dans un module de classe. À mon avis ça ne vaut pas le coup. La touche Tab est faite pour changer contrôle.

Edit: Bonjour Lone-wolf.

 

[Lone-wolf]

Bonjour Dranreb

 

[vmax67]

Bonjour

merci pour vos réponses
La méthode de Draneb fonctionne parfaitement merci aussi à Lone-Wolf.

Vmax67

 

[vmax67]

Oups j'ai parlé trop vite,

Pour la méthode de Draneb ça copie les textbox suivant en trop, alors que que le premier textbox de cette même ligne n'est pas renseigné.
T(L, 6) = CDate(T_date.Text)
T(L, 7) = T_dem.Text
T(L, 8) = T_aff.Text: Next L

 

[Dranreb]

Eh bien ajoutez des tests pour vérifier s'il y a lieu de renseigner la ligne ou d'abandonner la boucle par un Exit For

 

[vmax67]

Pas trop doué pour ce type de code.
comment faire pour ajouter ce test

 

[Dranreb]

Et bien vous mettez comme première instruction de la boucle par exemple :
If Me("T" & 3 * L - 2).Text = "" Then Exit For

 

[vmax67]

Bonsoir,

Merci