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
