Simplification code

vmax67 · 25 Février 2018

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 · 25 Février 2018

Bonjour vmax

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

VB:

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

VB:

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 · 25 Février 2018

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

VB:

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 · 25 Février 2018

Bonjour Dranreb

vmax67 · 25 Février 2018

Bonjour

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

Vmax67

vmax67 · 25 Février 2018

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 · 25 Février 2018

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 · 25 Février 2018

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

Dranreb · 25 Février 2018

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

vmax67 · 28 Février 2018

Bonsoir,

Merci

Simplification code

vmax67

XLDnaute Occasionnel

Lone-wolf

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

vmax67

XLDnaute Occasionnel

vmax67

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

vmax67

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

vmax67

XLDnaute Occasionnel

Discussions similaires