macro lente. manque un code style "private workbook" ?

[man]

Bonsoir à tous et à toutes,

Grace à votre aide j'ai pu développer 2 applications qui fonctionnent bien mais seulement quand lorsque je les ouvre une à une (pas en meme temps) car sinon l'execution d'une macro devient très lente (1 minute d'attente).
Pourtant ces 2 applications sont totalement independante et aucune des 2 ne fait appel à des données externes.
Débutant, en VBA je pense d'après ce que j'ai lu dans l'aide excel, qu'il manque des codes du style "private workbook" ou qq chose dans le genre.
Quelqu'un aurait il la bonté d'éclairer ma lanterne ?
(est ce que cela peut etre la cause et si oui, quel code mettre et où ?)

 

[vincent]

Bonsoir

je pense que tu es sur la bonne piste, il faudrait voir un exemple de ton code pour être sur mais je crois que si tu lances tes macros elles s'appliquent sur le classeur actif et cela peut donner des resultats trés suprenant parfois !

Ensuite pour être sur que ta macro travail avec les bonnes réfèrences tu peux rajouter des 'thisworbook' au bon endroits par exemple au lieu de variable=sheets(1).cells(1,1) il faut mettre variable=thisworkbook.sheets(1).cells(1,1)

Si tu veux plus d'infos n'hesite pas à revenir sur ce fil voir à mettre un exemple de ton fichier zippé

A plus

@+Vincent

 

[man]

bonjour Vincent, le forum,

savoir où placer les codes dépasse mes connaissances alors si tu veux bien me donner un coup de main, j'en serais ravi.
je ne parvient pas à compresser les classeurs en dessous de 50 ko; je met donc les macros ci-après.

le classeur "planning" est composé de 8 feuilles semblables, avec 4 boutons identiques sur chaque feuille pour lancer une macro qui ne s'applique qu'à la feuille d'où le bouton à été pressé. ces 4 macros sont regroupé dans 2 modules (je pourrais les mettre dans un seul d'ailleurs...), comme décrit ci-après.
c'est la macro "trier" qui est lente lorsque le 2eme classeur est ouvert.

Bonne journée à tous.



classeur " planning", module 1 , macro "trier" :
NB : dans cette macro il y a 2 codes pour effacer les " # " situé en C2, car le 2eme code intitulé " efface les lignes " ne fonctionnait pas toujours bien (plantage si lancé 2 fois de suite).
-------------------------------------------------------------------------------------
Option Explicit


Sub trier()

' deprotéger la feuille
ActiveSheet.Unprotect


'effacer le contenu des colonnes G et H
Range("G2:H250").Select
Selection.ClearContents

'trier les lignes
Range("A2:E250").Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


'effacer les #
Dim Plage As Range
Dim Cell As Range

Set Plage = Range("C2:C" & Range("C65535").End(xlUp).Row)

For Each Cell In Plage
If Cell.Value = "#" Then
Cell.Clear
End If
Next Cell


'macro de jean marie
Dim c As Range
Dim firstAddress As String
Dim ChaineSelection As String
Dim I As Double

Application.ScreenUpdating = False

'efface les lignes
ChaineSelection = ""
With Range("C2", Range("C65536").End(xlUp).Address)
Set c = .Find("#", After:=Range("C2"))
If Not c Is Nothing Then
firstAddress = c.Address
Do
ChaineSelection = ChaineSelection & Range(c.Offset(0, -2), c.Offset(0, 2)).Address & ","

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
ChaineSelection = Mid(ChaineSelection, 1, Len(ChaineSelection) - 1)
Range(ChaineSelection).Delete shift:=xlUp
End If
End With


'insère les lignes
For I = Range("E65536").End(xlUp).Row To 2 Step -1
If Range("E1").Offset(I - 1, 0) > 1 Then
Range(Range("A1").Offset(I, 0), Range("E1").Offset(Range("E1").Offset(I - 1, 0) + I - 2, 0)).Insert shift:=xlDown
Range(Range("C1").Offset(I, 0), Range("C1").Offset(Range("E1").Offset(I - 1, 0) + I - 2, 0)) = "#"
End If
Next


Dim vLigne As Double

vLigne = 1
For I = 1 To Range("J65536").End(xlUp).Row - 1
If Range("k1").Offset(I, 0) > 0 Then
Range(Range("G1").Offset(vLigne, 0), Range("G1").Offset(vLigne + Range("k1").Offset(I, 0) - 1, 0)) = Range("J1").Offset(I, 0)
vLigne = vLigne + Range("k1").Offset(I, 0)
End If
Next

'fin de la macro de jean marie

' recopier la formule de H2 à H250
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[-4]),"""",RC[-4]-(RC[-1]+2))"
Range("H2:H250").Select
Selection.FillDown


'enlever protection cellule
Range("A2:I65536").Select
Selection.Locked = False


'se positionner en B2
Range("B2").Select

'protéger la feuille
ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.ScreenUpdating = True

End Sub




classeur " planning", module 2 :

-------------------------------------------------------------------------------------
Option Explicit

Sub effacer()

' deprotéger la feuille
ActiveSheet.Unprotect

'effacer le contenu des colonnes G et H
Range("G2:H250").Select
Selection.ClearContents

'trier les lignes
Range("A2:E250").Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


'effacer les #
Dim Plage As Range
Dim Cell As Range

Set Plage = Range("C2:C" & Range("C65535").End(xlUp).Row)

For Each Cell In Plage
If Cell.Value = "#" Then
Cell.Clear
End If
Next Cell


'enlever protection cellule
Range("A2:I65536").Select
Selection.Locked = False


'se placer en B2
Range("B2").Select

'proteger la feuille
ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True


Application.ScreenUpdating = True


End Sub

------------------------------------------------------------------------------------------
Sub imprimer1page()

ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True

End Sub

-----------------------------------------------------------------------------------------
Sub imprimer2pages()

ActiveWindow.SelectedSheets.PrintOut From:=1, To:=2, Copies:=1, Collate _
:=True
End Sub


enfin, toujours dans ce classeur "planning", j'ai la macro suivante dans thisworkbook :

-----------------------------------------------------------------------------------
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Save
End Sub




dans le 2eme classeur "stock", il y a :

dans une feuille
------------------------------------------------------------------
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

Dim x As Integer
Dim cible As String

On Error Resume Next

cible = Target.Value
Worksheets(cible).Activate
x = Worksheets(cible).Range("a1").End(xlDown).Row + 1

Worksheets(cible).Range("A" & x).Select

End Sub



dans environ 300 autres feuilles (un bouton me renvoie à la feuille d'accueil "recap")
---------------------------------------------------------------------
Private Sub CommandButton1_Click()
Sheets("Récap").Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

End Sub


dans "this workbook"
-------------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Save
End Sub


dans un module et avec activation par un bouton situé sur chaque feuille (sauf 2) et pour la feuille où est situé le bouton
-----------------------------------------------------------------
Sub tripardate()

'
Range("A6:H65536").Select
Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


Dim Fin As Integer
Range("a6").Select ' selectionne la cellule a6 comme cellule de depart
Fin = Range("a6").End(xlDown).Row 'Definie jusqu'ou les cellules sont remplis dans le colonnes A
Range("H6").Select
ActiveCell.FormulaR1C1 = _
"=(SUM(RC[-4]:R6C[-4])-SUM(RC[-3]:R6C[-3]))+(SUM(RC[-2]:R6C[-2])-SUM(RC[-1]:R6C[-1]))"
Range("H6").Copy
Range("H6:H" & Fin).Select 'selection de la range de cellule où copier
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False 'copie la formule

Application.CutCopyMode = False

Dim x As Integer
x = Range("a6").End(xlDown).Row + 1
Range("A" & x).Select


End Sub

 

[vincent]

Re

Vu ce que tu viens d'ecrire (un bouton sur chaque feuille pour lancer la macro) et si ta macro trier donne le resultat voulu lorsque les deux classeurs sont ouvert je ne comprend pas pourquoi cela ralentit l'execution de ta macro.Exceptionnellement (ce n'est pas dans l(interêt du site) et si ça ne te pose pas de probleme tu peux m'envoyer tes fichiers sur ma bal.

A plus

@+Vincent

 

[man]

bonjour vincent,

merci pour ta proposition, mais j'avais pas cocher " recevoir la reponse par mail" donc je n'ai pas ton adresse.
si tu veux bien me repondre une nouvelle fois pour que je la reçoive.
merci.
ps : toutes les macros fonctionnent effectivement bien hormis ce probleme de lenteur quand les 2 classeurs sont ouverts.

 

[vincent]

Re

je pense avoir trouvé le problème.Même sans aucun lien entre les fichier excel recalcule toutes les formules de ton fichier essai stock lorsque tu lances ta macro ce qui le ralentit.Donc pour eviter cela

1 n'ouvre pas de fichier avec des formules quant tu utilises ton fichier planning
2 dans le menu 'Outils'>'Options...' onglet 'Calcul' dans mode de calcul cliques sur 'Sur ordre'

Voilà

A plus

@+Vincent

 

[man]

Bonjour Vincent, le forum

merci Vincent pour ton diagnostic.
j'avais aussi constater que le problème de lenteur disparaissait lorsque j'enlevais le calcul automatique mais je m'étais dit que cela ne pouvait pas être la cause réelle vu que les 2 fichiers sont indépendants.
Je ne comprends d'ailleurs toujours pas pourquoi excel réagit comme ça. Mais bon faute de mieux, j'ai adopté cette solution en rajoutant un code dans ma macro qui desactive et réactive le calcul automatique (merci l'enregisteur....).

Merci encore Vincent et bonne journée à tous.