Microsoft 365 Ralentissement sur macro

  • Initiateur de la discussion SebJ62
  • Date de début
S

SebJ62

Guest
Bonjour

J'ai un problème sur un fichier Excel utilisé par notre service production.
Dans ce classeur, il y a une macro qui effectue (entre autres choses) un parcours sur un onglet du classeur, synthétise des données et reporte ses calculs dans un autre onglet. Cette macro fonctionne parfaitement et s’exécute en 5-10 secondes environ ..... sauf si un deuxième classeur est ouvert.
Ce 2ème classeur également utilisé par le bureau de production, n'a pas de lien avec le premier (pas de données prise dans l'un vers l'autre ou inversement), mais contient de nombreuses formules et quelques macros.
Si ce deuxième classeur est ouvert, alors la macro s’exécute en 3 à 4 MINUTES.
Le calcul automatique est bien désactivé au début de la macro, et ré-activé à la fin.
J'ai fait le test avec d'autres classeurs ouverts en même temps que le premier. J'ai le même phénomène dans le cas où le 2nd classeur contient de nombreuses formules, onglets, calculs....
Avez-vous une idée de ce qui peut provoquer ce ralentissement ???

Cordialement
Sébastien
 
S

SebJ62

Guest
Re-bonjour,

J'apporte une petite précision :
J'ai fait de nombreux tests à l'aide du débugger et j'ai identifié les lignes posant "problème".
For i = 2 To iMax
If tbEXT(i, 8) = "FRANCE" Then
wsSAM.Cells(iLIG + 4, 12) = wsSAM.Cells(iLIG + 4, 12) + tbEXT(i, 10) 'QTE CMDE France
Else
wsSAM.Cells(iLIG + 4, 13) = wsSAM.Cells(iLIG + 4, 13) + tbEXT(i, 10) 'QTE CMDE Export
End If
Next i
Si je met en commentaire les 2 lignes dans le IF...ELSE...ENDIF (wsSAM.celles () = ....), le calsseur se calcule en quelques secondes. Comme si le fait de mettre à jour une cellule provoquait un recalcul dans les autres classeurs ouverts et cela malgré le "Application.Calculation = xlCalculationManual" en début de macro.

Merci d'avance pour vos conseils.
Sébastien
 
S

SebJ62

Guest
Bonjour

Difficile de vous fournir le classeur : il s'agit d'un fichier utilisé par notre bureau de production, il contient de nombreuses références à nos produits et à nos process de fabrication. C'est confidentiel.
Par contre, je peux vous donner la macro complète.
A noter néanmoins que la macro fonctionne parfaitement et rapidement si aucun autre classeur n'est ouvert en même temps. Tout le noeud du problème est là. Je ne dit pas que la macro est parfaite (il y a surement à optimiser), mais il semble bien que ce ne soit pas la macro en elle-même qui pose problème, mais le fait que 2 classeurs soient ouverts en même temps au moment de son execution.

Voici la macro :
Sub OuvrePoint()
'Ouvre le fichier issu du prolab SUIVI DE PRODUCTION
Dim iMax, iMaxFab, iCol, iLIG, iPTR, iMaxSAM As Long
Dim FSO As New FileSystemObject
Dim fic As File
Dim sTmp As String
Dim sName As String
Dim wkb, wkbPoint As Workbook
Dim ws, wsSAM, wsFAB As Worksheet
Dim dDeb, dFin As Date
Dim tbCMD, tbEXT, tbFab, tbSAM As Variant
Dim bFound As Boolean
Dim i, j, k, x As Long
Dim xREP As Variant

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Set wkb = ActiveWorkbook
sName = ActiveWorkbook.Name

Set fic = FSO.GetFile(cEXTRACT)

Workbooks.OpenText Filename:="\\192.168.62.219\ftp_progi\Extraction.txt", _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 5), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
, 1), Array(16, 1), Array(17, 1), Array(18, 2), Array(19, 1), Array(20, 1), Array(21, 1), _
Array(22, 1), Array(23, 1), Array(24, 1)), DecimalSeparator:=",", TrailingMinusNumbers:=True
Set wkbPoint = ActiveWorkbook
Set ws = ActiveSheet

iMax = Range("A65535").End(xlUp).Row
iCol = Range("A1").End(xlToRight).Column
ReDim tbCMD(1 To iMax - 1, 1 To iCol)
tbCMD = Range(Cells(2, 1), Cells(iMax, iCol)) 'on saute l'entete

wkb.Sheets("EXTRACTION").Activate

j = Range("A65535").End(xlUp).Row
'on va chercher si le tableau tbDATA existe et on le modifie ou alors on le crée
For i = 1 To ActiveSheet.ListObjects.Count
If ActiveSheet.ListObjects(i).Name = "tbDATA" Then
ActiveSheet.ListObjects("tbDATA").Resize Range("$A$1:$W$3")
If j > 3 Then
Rows("4:" & j).Select
Selection.ClearContents
Range("A3").Select
End If
Exit For
End If
Next i
Range(Cells(2, 1), Cells(iMax, iCol)) = tbCMD
Application.CutCopyMode = False
ActiveSheet.ListObjects("tbDATA").Resize Range("$A$1:$" & Chr(64 + iCol) & "$" & iMax)



Application.Goto Reference:="tbDATA"
ws.Activate
Set MyRange = Range("B:B")
dDeb = Application.WorksheetFunction.Min(MyRange)
dFin = Application.WorksheetFunction.Max(MyRange)
wkbPoint.Close savechanges:=False

''''''
'''''' CONSTRUCTION DE L'ONGLET PLANNING FABRICATION
''''''
Set wsFAB = wkb.Sheets("Planning Fabrication")
wsFAB.Activate
Cells(2, 8) = "Extraction du " & fic.DateLastModified
Cells(2, 13) = " Départs du " & Format(dDeb, "DD/MM/YYYY") & " au " & Format(dFin, "DD/MM/YYYY")
iMaxFab = Range("A65535").End(xlUp).Row

''''''
'''''' CONSTRUCTION DE L'ONGLET PLANNING SAM
''''''
Set ws = wkb.Sheets("EXTRACTION")
Set wsSAM = wkb.Sheets("Planning SAM")

ws.Activate
iMax = Range("A65535").End(xlUp).Row
ReDim tbEXT(1 To iMax, 1 To 24)
tbEXT = Range(Cells(1, 1), Cells(iMax, UBound(tbEXT)))

wsSAM.Activate
iMaxSAM = Range("A65535").End(xlUp).Row
ReDim tbSAM(1 To iMax, 1 To 20)
'reset des cumuls
If wsSAM.ProtectContents = True Then
wsSAM.Unprotect Password:="LL"
End If
Range("tbSAM[Ventes France (KG)]").ClearContents
Range("tbSAM[Ventes Export (KG)]").ClearContents
tbSAM = Range("tbSAM[#Data]")

iCol = Range("tbDATA[Nature prod.]").Column
iPTR = 1
For i = 2 To iMax
If tbEXT(i, iCol) = "SAM" Then
'on recherche la ligne dans planning sam, si pas trouvé on l'ajoute dans le tableau
bFound = False
For j = 1 To UBound(tbSAM)
If tbSAM(j, 1) = tbEXT(i, 3) Then
bFound = True
iLIG = j
Exit For
End If
Next j
If Not bFound Then
xREP = MsgBox("ATTENTION LE CODE " & tbEXT(i, 3) & " n'existe pas dans le planning SAM !!!", vbCritical)
End If
If tbEXT(i, 8) = "FRANCE" Then
wsSAM.Cells(iLIG + 4, 12) = wsSAM.Cells(iLIG + 4, 12) + tbEXT(i, 10) 'QTE CMDE France
Else
wsSAM.Cells(iLIG + 4, 13) = wsSAM.Cells(iLIG + 4, 13) + tbEXT(i, 10) 'QTE CMDE Export
End If
End If
Next i

If wsSAM.ProtectContents = False Then
wsSAM.Protect Password:="LL"
End If

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

' Definition des plages
ActiveWorkbook.Names("stkSAMSpec").RefersTo = "='Planning SAM'!$K$5:$K$" & iMaxSAM
ActiveWorkbook.Names("stkSAMFdj").RefersTo = "='Planning SAM'!$S$5:$S$" & iMaxSAM
ActiveWorkbook.Names("stkSAMSrc").RefersTo = "='Planning SAM'!$F$5:$F$" & iMaxSAM
ActiveWorkbook.Names("stkSAMSfam").RefersTo = "='Planning SAM'!$D$5:$D$" & iMaxSAM
ActiveWorkbook.Names("stkSAMPresta").RefersTo = "='Planning SAM'!$E$5:$E$" & iMaxSAM
ActiveWorkbook.Names("stkSAMLatin").RefersTo = "='Planning SAM'!$G$5:$G$" & iMaxSAM
ActiveWorkbook.Names("stkSAMEtat").RefersTo = "='Planning SAM'!$C$5:$C$" & iMaxSAM
ActiveWorkbook.Names("stkSAMCdt").RefersTo = "='Planning SAM'!$J$5:$J$" & iMaxSAM
ActiveWorkbook.Names("stkSAMCal").RefersTo = "='Planning SAM'!$H$5:$H$" & iMaxSAM

Sheets("Planning Fabrication").Select
Range("T5").Select
'ActiveCell.FormulaR1C1 = _
"=SUMIFS(stkSAMFdj,'Planning SAM'!R[-1]C[-17]:R[43]C[-17],'Planning Fabrication'!RC[-19])"
'Range("T6").Select

End Sub

Autre remarque : si je commente les 2 lignes en gras, même si un deuxième classeur est ouvert, la macro met 2 à 3 secondes à s'éxecuter (sinon 3-4 minutes).

Merci d'avance ;-)
Sébastien
 
S

SebJ62

Guest
A priori à activer le classeur que l'on vient d'ouvrir (à savoir le fichier issus de notre ERP et déposé sur un dossier ftp).
Je dis "a priori" car ce n'est pas moi qui ai développé cette macro. ;-)
Sébastien
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 949
Membres
101 851
dernier inscrit
vaiata