Simplification de code

treza88 · 1 Septembre 2011

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:

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

Etienne2323 · 1 Septembre 2011

Re : Simplification de code

Salut treza,
à mes yeux, ce code semble bien structuré et je ne crois pas que tu puisses gagner beaucoup de temps d'exécution par une réécriture plus concise de ce code. Ceci dit, c'est mon opinion. Je suis toutefois convaincu que les as du VBA pourront quand même te remodeler ça pour obtenir la structure la plus efficace.

D'ici là, voici quelques pistes de solutions qui pourraient t'aider.

1) Essaye d'enlever le calcul automatique en début de code

Code:

Application.Calculation = xlCalculationManual

Tu dois par contre le remettre en fin de code :

Code:

Application.Calculation = xlCalculationAutomatic

2) Vérifie s'il y a des macros évènementielles qui sont lancées par ce code. Si c'est le cas, alors peut-être qu'un

Code:

Application.EnableEvents = False

en début de code et un

Code:

Application.EnableEvents = True

en fin de code pourrait t'aider.

3) En postant un fichier exemple, il est beaucoup plus facile de tester et de pouvoir déterminer où est-ce qu'on peut gagner du temps d'exécution.

À te relire pour plus,

Cordialement,

Étienne

treza88 · 1 Septembre 2011

Re : Simplification de code

Ok merci Etienne2323, je vais voir suivant tes pistes et voir ce que ça donne, pour ce qui est de mettre le fichier complet je ne suis pas contre , mais il faut que je verifie si une patie peut fonctionner toute seule car le fichier fait appel a un logiciel exterieur en exportant une partie des données.
Donc il faut que je regarde avant, en plus tout le code qui est dedant n'est certainement pas au top je ne suis pas un programmeur chevroné et j'ai eu de l'aide de different forum qui m'ont aider à le construire un peu bout a bout, meme si il y a quand meme de ma propre création et certainement pas la meilleur, mais ça fonctionne.

Pierrot93 · 2 Septembre 2011

Re : Simplification de code

Bonjour Treza, Etienne🙂

tu peux également te passer des "select" ou "activate", très rarement nécessaires en vba, par exemple ceci :

Code:

Rows(r).Select
        Rows(r).Copy Rows(s)

deviendrait :

Code:

Rows(r).Copy Rows(s)

bonne journée
@+

treza88 · 5 Septembre 2011

Re : Simplification de code

Merci à vous deux
Oui aparemment ça fonctionne mieux.
J'ai dejà retravailler une petite partie du code comme ceci.

http://www.developpez.net/forums/d1.../excel/macros-vba-excel/simplification-code/#

Code:

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

Effectuez une recherche sur Excel Downloads...

Simplification de code

treza88

XLDnaute Occasionnel

Etienne2323

XLDnaute Impliqué

treza88

XLDnaute Occasionnel

Pierrot93

XLDnaute Barbatruc

treza88

XLDnaute Occasionnel

Discussions similaires

Nous accordons de l'importance à votre vie privée