Discussion :

[zoumzoum59]

Bonjour à tous

Je cherche a simplifier un code d'une proceduer sur un bouton ok d'une userform car j'ai un temps d'attente entre chaque saisie ce qui n'est pas l'ideal pour de la saisie.

J'ai essyé de supprimer au maximum les select, mais apres je bloc.

Voici mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
 
Private Sub Ok_Click()
Application.ScreenUpdating = False
If longueur.Text = "" Then
MsgBox ("Vous n'avez rien saisi !")
Else
'transfert des données vers les cellules
With ActiveCell
.Value = Reference.Text
.Offset(0, 1).Value = designation.Text
.Offset(0, 2).Value = nombre.Text
End With
    Dim Longu As Currency, Larg As Currency
Longu = Val(longueur.Text)
Larg = Val(largeur.Text)
    If Longu > Larg Then
        ActiveCell.Offset(0, 4).Value = longueur.Text
        If Chb_surcote = True And Dim_surcote_Long.Text <> 0 Then
        Call Surcote(ActiveCell.Offset(0, 22))
        ActiveCell.Offset(0, 28).Value = Dim_surcote_Long.Text
 End If
 
        ActiveCell.Offset(0, 5).Value = largeur.Text
        If Chb_surcote = True And Dim_Surcote_larg.Text <> 0 Then
        Call Surcote(ActiveCell.Offset(0, 23))
        ActiveCell.Offset(0, 29).Value = Dim_Surcote_larg.Text
 End If
 
    Else
        ActiveCell.Offset(0, 4).Value = largeur.Text
        If Chb_surcote = True And Dim_surcote_Long.Text <> 0 Then
        Call Surcote(ActiveCell.Offset(0, 22))
        ActiveCell.Offset(0, 28).Value = Dim_surcote_Long.Text
 End If
 
        ActiveCell.Offset(0, 5).Value = longueur.Text
        If Chb_surcote = True And Dim_Surcote_larg.Text <> 0 Then
        Call Surcote(ActiveCell.Offset(0, 23))
        ActiveCell.Offset(0, 29).Value = Dim_Surcote_larg.Text
 End If
 
    End If
ActiveCell.Offset(0, 8).Value = SensFil.Text
 
ActiveCell.Offset(1, 0).Select
'remet tous les textbox a zero de la user form
Dim Ctrl As Control
 
For Each Ctrl In Me.Controls
    If TypeOf Ctrl Is MSForms.TextBox Then Ctrl.Value = ""
Next
'--------------------------------------------
'ajout automatique d'une ligne au tableau
Dim r As Integer, s As Integer, q As Integer, p As Integer
q = ActiveCell.Row ' N°de ligne en dessous de la derniere ligne saisi
Set firstCell = Range("F5") ' colonne avec formule mais pas de donnée
Set lastCell = Range("F65536").End(xlUp)
p = Range(lastCell, lastCell).Row ' Dernier N° de ligne du tableau
If p = q + 1 Then
    Range(lastCell, lastCell).Select
        r = ActiveCell.Row
        ActiveCell.Offset(1, 0).EntireRow.Select
        s = ActiveCell.Row
        Selection.Insert Shift:=xlDown
        Rows(r).Select
        Rows(r).Copy Rows(s)
End If
'reselection de la cellule d'entrée de donnée
Set firstCell = Range("D5")
Set lastCell = Range("D65536").End(xlUp)
Range(lastCell, lastCell).Offset(1, -1).Select
End If
Reference.SetFocus 'reactive la combobox reference
Application.Calculate
Application.ScreenUpdating = True
Set lastCell = Range("D65536").End(xlUp)
lastCell.Select
ActiveCell.Offset(1, -1).Select
Dim Ligne As Integer, Colonne As Integer
Ligne = lastCell.Row - 29
If Ligne >= 0 Then
With ActiveWindow
.ScrollRow = Ligne + 1
End With
End If
End Sub
 
Private Sub UserForm_Activate()
If ActiveSheet.Index < 4 Or (ActiveSheet.Index Mod 2) = 0 Or Worksheets.Count = ActiveSheet.Index Then
    MsgBox "Attention mauvaise selection, aucune saisie ne peut se faire sur cette feuille!"
    Zone2.Hide
    Exit Sub
End If
Num = ActiveSheet.Index
NomFeuille.ListIndex = ((Num - 1) / 2) - 2
Reference.ListIndex = ind
Reference.SetFocus
Set lastCell = Range("D65536").End(xlUp)
lastCell.Select
ActiveCell.Offset(1, -1).Select
Dim Ligne As Integer, Colonne As Integer
Ligne = lastCell.Row - 29
If Ligne >= 0 Then
With ActiveWindow
.ScrollRow = Ligne + 1
End With
End If
End Sub

Si quelqu'un peut me donner un coup de main, merci d'avance

[AlainTech]

Bonjour,

En dehors de l'indentation fantaisiste de ton code (qui n'a pas d'influence sur la vitesse d'exécution, j'en conviens mais qui n'invite pas à l'analyser) et de l'utilisation de ActiveCell, tu peux essayer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Calculation = xlCalculationManual

en début de code et

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Calculation = xlCalculationAutomatic

en fin.

Sans garantie

[zoumzoum59]

Merci AlainTech

Oui aparemment ça fonctionne mieux, par contre tu me parle de Activecell, je suis certainement d'accord avec toi mais comment je pourrais les supprimer.
Parceque je ne vois pas comment je pourrais coder autrement, je ne suis pas un pro en VBA et je suis toujours preneur de conseille pour pouvoir m'ameliorer.

J'ai dejà retravailler le une petite partie du code comme ceci mais c'est pas forcement bien.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
 
Private Sub Ok_Click()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    If longueur.Text = "" Then
        MsgBox ("Vous n'avez rien saisi !")
    Else
        'transfert des données vers les cellules
        With ActiveCell
            .Value = Reference.Text
            .Offset(0, 1).Value = designation.Text
            .Offset(0, 2).Value = nombre.Text
        End With
        Dim Longu As Currency, Larg As Currency
        Longu = Val(longueur.Text)
        Larg = Val(largeur.Text)
        If Longu > Larg Then
            ActiveCell.Offset(0, 4).Value = longueur.Text
            If Chb_surcote = True And Dim_surcote_Long.Text <> 0 Then
                Call Surcote(ActiveCell.Offset(0, 22))
                ActiveCell.Offset(0, 28).Value = Dim_surcote_Long.Text
            End If
            ActiveCell.Offset(0, 5).Value = largeur.Text
            If Chb_surcote = True And Dim_Surcote_larg.Text <> 0 Then
                Call Surcote(ActiveCell.Offset(0, 23))
                ActiveCell.Offset(0, 29).Value = Dim_Surcote_larg.Text
            End If
        Else
            ActiveCell.Offset(0, 4).Value = largeur.Text
            If Chb_surcote = True And Dim_surcote_Long.Text <> 0 Then
                Call Surcote(ActiveCell.Offset(0, 22))
                ActiveCell.Offset(0, 28).Value = Dim_surcote_Long.Text
            End If
            ActiveCell.Offset(0, 5).Value = longueur.Text
            If Chb_surcote = True And Dim_Surcote_larg.Text <> 0 Then
                Call Surcote(ActiveCell.Offset(0, 23))
                ActiveCell.Offset(0, 29).Value = Dim_Surcote_larg.Text
            End If
        End If
        ActiveCell.Offset(0, 8).Value = SensFil.Text
 
        'remet tous les textbox a zero de la user form
        Dim Ctrl As Control
        For Each Ctrl In Me.Controls
            If TypeOf Ctrl Is MSForms.TextBox Then Ctrl.Value = ""
        Next
        '--------------------------------------------
        'ajout automatique d'une ligne au tableau
        Dim r As Integer, s As Integer, q As Integer, p As Integer
        q = ActiveCell.Offset(1, 0).Row    ' N°de ligne en dessous de la derniere ligne saisi
        Set firstCell = Range("F5")    ' colonne avec formule mais pas de donnée
        Set lastCell = Range("F65536").End(xlUp)
        p = Range(lastCell, lastCell).Row    ' Dernier N° de ligne du tableau
        If p = q + 1 Then
 
            r = ActiveCell.Offset(1, 0).Row
            s = ActiveCell.Offset(2, 0).Row
            ActiveCell.Offset(2, 0).EntireRow.Insert Shift:=xlDown
            Rows(r).Copy Rows(s)
 
        End If
        'reselection de la cellule d'entrée de donnée
        Set firstCell = Range("D5")
        Set lastCell = Range("D65536").End(xlUp)
        Range(lastCell, lastCell).Offset(1, -1).Select
    End If
    Reference.SetFocus    'reactive la combobox reference
    Application.ScreenUpdating = True
    Set lastCell = Range("D65536").End(xlUp)
    lastCell.Offset(1, -1).Select
 
    Application.Calculation = xlCalculationAutomatic
 
    Dim Ligne As Integer, Colonne As Integer
    Ligne = lastCell.Row - 29
    If Ligne >= 0 Then
        ActiveWindow.ScrollRow = Ligne + 1
    End If
End Sub

Si tu as des suggestions je suis preneur.

[AlainTech]

Bonjour,

Déjà, bien pour l'indentation. C'est nettement plus lisible.

Petit conseil:
Les variables étant définies au lancement de l'application, il vaut mieux regrouper les définitions en début de procédure.
Pour ma part, je les définis une par ligne en les classant por ordre alphabétique. Ca me permet de les retrouver facilement. Mais ce n'est qu'une façon personnelle de travailler.

Pour ton ActiveCell, on ne sait pas ce qui la détermine. Est-ce une action de l'utilisateur ou une autre action de ton programme?

[zoumzoum59]

Pour Activecell c'est la procedure d'activation de la userform qui positionne est selectionne la premiere cellule d'entrée de saisie dans le tableau.
Je met le code de la procedure, j'en ai profité pour classer mes variables a ta façon dit moi si c'est bien comme cela que tu vois les choses.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Private Sub UserForm_Activate()
    Dim Colonne As Integer
    Dim Ligne As Integer
    If ActiveSheet.Index < 4 Or (ActiveSheet.Index Mod 2) = 0 Or Worksheets.Count = ActiveSheet.Index Then
        MsgBox "Attention mauvaise selection, aucune saisie ne peut se faire sur cette feuille!"
        Zone2.Hide
        Exit Sub
    End If
    Num = ActiveSheet.Index
    NomFeuille.ListIndex = ((Num - 1) / 2) - 2
    Reference.ListIndex = ind
    Reference.SetFocus
    Set lastCell = Range("D65536").End(xlUp)
   lastCell.Offset(1, -1).Select
 
    Ligne = lastCell.Row - 29
    If Ligne >= 0 Then
        ActiveWindow.ScrollRow = Ligne + 1
    End If
End Sub

[galopin01]

Bonjour,
Je m'immisce un peu dans la converse...
On peut sans doute optimiser et clarifier le code de la manière ci dessous mais il est probable que ce sont les call qui ralentissent le plus l'exécution.

Le code modifié (attention, bien que j'ai essayé de faire propre, je ne peux pas tester : sans garantie c'est l'idée qui compte...)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Private Sub Ok_Click()
Dim Longu As Currency, Larg As Currency
Dim Ctrl As Control
Dim r As Integer, s As Integer, q As Integer, p As Integer
Dim Ligne As Integer, Colonne As Integer
Dim iR As Long, iC As Long
 
iR = ActiveCell.Row
iC = ActiveCell.Column
 
 
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
If longueur.Text = "" Then
        MsgBox ("Vous n'avez rien saisi !")
Else
        'transfert des données vers les cellules
 
      Cells(iR, iC).Value = Reference.Text
      Cells(iR, iC + 1).Value = designation.Text
      Cells(iR, iC + 2).Value = nombre.Text
        Longu = Val(longueur.Text)
        Larg = Val(largeur.Text)
        If Longu > Larg Then
            Cells(iR, iC + 4).Value = longueur.Text
            If Chb_surcote = True And Dim_surcote_Long.Text <> 0 Then
                Call Surcote(Cells(iR, iC + 22))
                Cells(iR, iC + 28).Value = Dim_surcote_Long.Text
            End If
            Cells(iR, iC + 5).Value = largeur.Text
            If Chb_surcote = True And Dim_Surcote_larg.Text <> 0 Then
                Call Surcote(Cell(iR, iC + 23))
                Cells(iR, iC + 29).Value = Dim_Surcote_larg.Text
            End If
        Else
            Cell(iR, iC + 4).Value = largeur.Text
            If Chb_surcote = True And Dim_surcote_Long.Text <> 0 Then
                Call Surcote(Cell(iR, iC + 22))
                Cells(iR, iC + 28).Value = Dim_surcote_Long.Text
            End If
            Cells(iR, iC + 5).Value = longueur.Text
            If Chb_surcote = True And Dim_Surcote_larg.Text <> 0 Then
                Call Surcote(Cell(iR, iC + 23))
                Cells(iR, iC + 29).Value = Dim_Surcote_larg.Text
            End If
        End If
        Cell(iR, iC + 8).Value = SensFil.Text
 
        'remet tous les textbox a zero de la user form
 
        For Each Ctrl In Me.Controls
            If TypeOf Ctrl Is MSForms.TextBox Then Ctrl.Value = ""
        Next
        '--------------------------------------------
        'ajout automatique d'une ligne au tableau
 
        q = iR + 1  ' N°de ligne en dessous de la derniere ligne saisi
        Set firstCell = Range("F5")    ' colonne avec formule mais pas de donnée
        'Set lastCell = Range("F65536").End(xlUp) 'confus et inutile
        p = Range("F65536").End(xlUp).Row    ' Dernier N° de ligne du tableau
        If p = q + 1 Then
            r = iR + 1
            s = iR + 2
            Rows(s).EntireRow.Insert Shift:=xlDown
            Rows(r).Copy Rows(s)
        End If
 
        'reselection de la cellule d'entrée de donnée
        Set firstCell = Range("D5")  'Est-ce vraiment utile ?
        'Set lastCell = Range("D65536").End(xlUp) 'toujours confus et inutile
        'Range(lastCell, lastCell).Offset(1, -1).Select 'peut-être inutile
                          'puisque tu refais un select 4 lignes plus bas
        'Là je suis un peu perdu avec les offset : peut-être
        iR = Range("D65536").End(xlUp).Row + 1
        Cell(iR, 3).Select
End If
    Reference.SetFocus    'reactive la combobox reference
    Application.ScreenUpdating = True
    ' Toujours un peu incertain : suis un peu perdu avec tous ces offset
    iR = Range("D65536").End(xlUp) + 1
    Cell(iR, 3).Select
    Application.Calculation = xlCalculationAutomatic
 
    'Ligne = iR - 29
    If iR >= 29 Then
        ActiveWindow.ScrollRow = iR + 1
    End If
End Sub

Je ne suis pas persuadé que les .Value et .Text soient bien utile :
Si nécessaire préférer des conversions explicites plutôt que la méthode bourrin :
blabla = CLng(Longueur)
plutôt que :
blabla.Value = longueur.Text

A+

[AlainTech]

Encore un petit conseil pour une programmation "propre".

Placer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Option Explicit

en début de chaque module pour forcer à déclarer toutes les variables.
Ca peut être fait automatiquement en cochant "Déclaration des variables obligatoire" dans les options de l'éditeur VBA.

Puisque ta cellule de destination est définie dans une procédure et utilisée dans une autre, je te conseille de placer un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim rDest As Range

en début de module de ton UserForm (sous le Option Explicit).

Ensuite, remplace

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set lastCell = Range("D65536").End(xlUp)
lastCell.Offset(1, -1).Select

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set rDest = Range("D65536").End(xlUp).Offset(1, -1)

Tu pourras alors utiliser rDest (la cellule de destination) dans tes autres procédures à la place de Selection.

Il reste un détail à régler: définir un objet Worksheet pour la feuille de destination.
Crois-tu pouvoir y arriver?
C'est assez important pour avoir un code stable car Range("D65536") ne dit pas sur quelle feuille on travaille et on est reparti pour devoir utiliser un Select pour que ça fonctionne.

[zoumzoum59]

Ok AlainTech,

J'ai essayé sans le tester completement de faire ceci, par contre je n'ai pas su faire aurtrement quand utilisant un ActiveSheet pour situer la feuille.

il ya peut etre un autre moyen, j'avais pensé à ThisWorkSheet mais ça n'avait pas l'air d'etre reconnu quand je l'ai taper dans un module.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Dim wFeuil As Worksheet
Dim rDest As Range
Set wFeuil = ActiveSheet
 
 
Set rDest = wFeuil.Range("D65536").End(xlUp).Offset(1, -1)

Dit moi si je suis sur la bonne voie


Et sinon merci galopin01 pour ton code qui est tres interressant, du fait d'utiliser des variables plutot que "ActiveCell.Offset...".
Par contre je n'ai pas compris quand tu parle de conversion explicite, si tu peux me mettre un exemple un peu plus precis, car pour le moment je ne vois pas comment je peux me passer de mes .value et .text

[AlainTech]

Dit moi si je suis sur la bonne voie

Indubitablement!

Quant à ActiveSheet, encore une fois, c'est une question de choix.
Si tu veux que l'utilisateur choisisse (et donc sélectionne) la feuille de travail, tu dois utiliser ActiveSheet.
Par contre, si c'est toi qui l'impose, tu connais son nom d'onglet.

Si tu veux que ton code fonctionne sur toutes les versions d'Excel et quel que soit le nombre de lignes remplies, je te conseille de remplacer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set rDest = wFeuil.Range("D65536").End(xlUp).Offset(1, -1)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set rDest = wFeuil.Cells(wFeuil.Rows.Count, 4).End(xlUp).Offset(1, -1)

Je ne suis pas persuadé que les .Value et .Text soient bien utile

Oh que si!

Il faut éviter de laisser VB prendre des décisions à notre place car il nous réserve parfois des surprises.
Le meilleur exemple est la conversion implicite de dates.
En Excel, concernant le contenu des cellules, il y a une différence fondamentale entre le . Value et le .Text.

VB.Net évolue dans le sens de ne plus accepter les conversions implicite et de forcer le programmeur à tout définir.

[Didier Gonard]

En Excel, concernant le contenu des cellules, il y a une différence fondamentale entre le . Value et le .Text.

tout à fait d'accord et même fondamentalement utile :

http://www.developpez.net/forums/d11...apres-virgule/

http://www.developpez.net/forums/d87...fichier-texte/

cordialement,

Didier