Acceleration code VBA

Le 04/10/2017 à 23:44

Bonsoir

J'ai un Userform dans lequel j'ai le code ci dessous pour ajouter des noms.

Je le trouve un peu trop lent et je voulais savoir s'il était possible de l'accélérer....

merci et bonne soirée

Ta

[code]'AJOUTER

Private Sub BtnAJOUTER_Click()

If CboNOM.Value = "" Then

MsgBox "Veuillez renseigner le champs 'Nom' "

Else

If MsgBox("confirmez l'ajout de données ?", vbYesNo, "confirmation") = vbYes Then

Sheets("ST").Activate

Range("A39").Select

Selection.End(xlDown).Select

Selection.Offset(1, 0).Select

ActiveCell = CboSECTION.Value

ActiveCell.Offset(0, 1).Value = CboSER

ActiveCell.Offset(0, 3).Value = CboGRA

ActiveCell.Offset(0, 4).Value = CboNOM

ActiveCell.Offset(0, 5).Value = TxtPRENOM

Sheets("HA").Activate

Range("A39").Select

Selection.End(xlDown).Select

Selection.Offset(1, 0).Select

ActiveCell = CboSECTION.Value

ActiveCell.Offset(0, 1).Value = CboSER

ActiveCell.Offset(0, 3).Value = CboGRA

ActiveCell.Offset(0, 4).Value = CboNOM

ActiveCell.Offset(0, 5).Value = TxtPRENOM

MsgBox "Fonctionnaire bien enregsitré", vbOKOnly + vbInformation, "CONFIRMATION"

'

' TRIHA Macro

'

'

Sheets("HA").Select

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _

Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _

SortOnValue.Color = RGB(191, 191, 191)

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _

Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _

SortOnValue.Color = RGB(0, 176, 240)

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _

Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _

SortOnValue.Color = RGB(0, 176, 80)

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _

Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _

SortOnValue.Color = RGB(255, 0, 0)

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _

Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _

SortOnValue.Color = RGB(255, 255, 0)

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _

Key:=Range("Tableau4[SERV]"), SortOn:=xlSortOnValues, Order:= _

xlAscending, CustomOrder:="OFF,SG,SCT,MAT,CTI,GAR,SYN,BUD", DataOption:= _

xlSortNormal

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _

Key:=Range("Tableau4[[GRA]]"), SortOn:=xlSortOnValues, Order:= _

xlAscending, CustomOrder:= _

"CD,CN,L.1,L.2,L.3,MA,MA1,MA2,MA3,MJ1,MJ2,MJ3,MJ4,B1,B2,B3,B4,B5,B6,B.1,B.2,B.3,B.4,B.5,B.6,B.7,G,G1,G2,G3" _

, DataOption:=xlSortNormal

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _

Key:=Range("Tableau4[NOM]"), SortOn:=xlSortOnValues, Order:=xlAscending, _

DataOption:=xlSortNormal

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _

Key:=Range("Tableau4[PRENOM]"), SortOn:=xlSortOnValues, Order:= _

xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Range("A6").Select

'TRI ST Macro

Sheets("ST").Select

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _

Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _

SortOnValue.Color = RGB(191, 191, 191)

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _

Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _

SortOnValue.Color = RGB(0, 176, 240)

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _

Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _

SortOnValue.Color = RGB(0, 176, 80)

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _

Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _

SortOnValue.Color = RGB(255, 0, 0)

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add( _

Range("Tableau4[SEC]"), xlSortOnCellColor, xlAscending, , xlSortNormal). _

SortOnValue.Color = RGB(255, 255, 0)

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _

Key:=Range("Tableau4[SERV]"), SortOn:=xlSortOnValues, Order:= _

xlAscending, CustomOrder:="OFF,SG,SCT,MAT,CTI,GAR,SYN,BUD", DataOption:= _

xlSortNormal

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _

Key:=Range("Tableau4[[GRA]]"), SortOn:=xlSortOnValues, Order:= _

xlAscending, CustomOrder:= _

"CD,CN,L.1,L.2,L.3,MA,MA1,MA2,MA3,MJ1,MJ2,MJ3,MJ4,B1,B2,B3,B4,B5,B6,B.1,B.2,B.3,B.4,B.5,B.6,B.7,G,G1,G2,G3" _

, DataOption:=xlSortNormal

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _

Key:=Range("Tableau4[NOM]"), SortOn:=xlSortOnValues, Order:=xlAscending, _

DataOption:=xlSortNormal

ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort.SortFields.Add _

Key:=Range("Tableau4[PRENOM]"), SortOn:=xlSortOnValues, Order:= _

xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("HA").ListObjects("Tableau4").Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Range("A6").Select

End If

End If

End Sub

/code]

Le 05/10/2017 à 07:24

Bonjour Tacentaure, le forum,

Tu obtiendrai certainement plus de réponses,

Cordialement,

Le 05/10/2017 à 07:43

Bonjour

Fichier trop lourd et ne peut être joint

Cdt

Le 05/10/2017 à 09:36

Bonjour,

Réduis ton fichier au minimum avec les éléments nécessaires pour une réponse à tes questions.

Sinon, enregistre le au format xlsb (<1mo) ou utilise ci-joint.

Sinon, il n'y a aucune variable déclarée, des Activate et Select inutiles.

Tu peux aussi optimiser la procédure avec un calcul en manuel et geler l'affichage (Application.ScreenUpdating).

Cela veut dire quoi être lent ? Quelle durée ? Tu fais comme un certain nombre d'opérations de tri...

Cdlt.

Le 07/10/2017 à 23:11

Bsr

J'ai essayé de diminuer le fichier mais j'ai d'autres soucis

cdt

22tableau-t-copie-2.xlsm (255.49 Ko)
Le 08/10/2017 à 11:25

Bonjour,

C'est quoi ce classeur ?

Travailles-tu sur Mac ?

Attention : Tu as plusieurs modules 'ThisWorkbook' (!?)

J'ai travaillé essentiellement sur l'ajout dans le formulaire.

Tes contrôles USF étaient mal nommés et j'ai utilisé les fonctionnalités des tableaux.

A te relire...

Cdlt.

9tableau-t-copie-2.xlsm (259.04 Ko)
Le 09/10/2017 à 10:56

Bonjour

Merci pour les conseils et les corrections.

Désolé pour ce fichier ....

En effet je travaille sur Mac avec excel 2011 et ce n'est pas terrible

J'alterne avec un autre PC et excel 2007

J'avais remarqué après coup , que les couleurs étaient différentes sur la feuille ST d'ou l'erreur qui survenait dans le tri.

Concernant la lenteur de la macro, pour l'envoi du classeur j'ai du supprimer deux feuilles ( il est donc moins représentatif de mon travail) où figuraient plusieurs formules pour différents calculs. Peut être est ce la qui ralentit l'ajout ou la modification de noms, plus de 30 secondes ???

Bon début de semaine

Cdt

T

Rechercher des sujets similaires à "acceleration code vba"