Application.screenupdating qui ne fonctionne plus
E
bonjour,
j'ai une vielle macro que j'avais réalisée en 2013 avec l'aide de certains d'entre vous et qui fonctionnait très bien jusqu'à ce qu'il soit récemment "amélioré".
depuis, la commande "application.screenupdating=false" ne fonctionne plus et la macro met beaucoup de temps à s’exécuter car affichage de tous les fichiers ouverts et lignes copiées.
J'ai beau comparer l'ancien fichier avec le nouveau, je ne vois pas pourquoi ça fonctionne avec l'ancien et pas avec le nouveau
nouveau code
Sub création_trame()
Application.ScreenUpdating = False
Sheets(1).Visible = 2
Sheets(2).Visible = 2
Sheets(3).Visible = 1
Dim nom_fichier As Variant
nom_fichier = Mid(ThisWorkbook.Name, 1, InStr(ThisWorkbook.Name, ".xls") - 1)
Sheets(1).Unprotect ("tramecfpla")
Sheets(2).Unprotect ("tramecfpla")
Sheets(3).Unprotect ("tramecfpla")
'***OUVERTURE DE FICHIER N°1 ET COPIE DES DESIGNATION DE COTES****************************
On Error GoTo CreaTrame
Application.ScreenUpdating = False
Workbooks.Open Filename:="W:\50-METROLOGIE\20-RAPPORTS\02-CLIENTS\" & Sheets(1).Range("client") & "\" & Sheets(1).Range("cmd_int") & "\" & Sheets(1).Range("code_produit") & "\N°OF" & Sheets(1).Range("of") & "\1.xls"
Application.ScreenUpdating = False
desicotes = 0
For i = 0 To 500
If Cells(8 + 2 * i, 3) <> "" Then
desicotes = desicotes + 1
Else
If Cells(10 + 2 * i, 3) <> "" Then
Windows(nom_fichier & ".xlsm").Activate
Exit For
End If
End If
Next
Windows(nom_fichier).Activate
Sheets(2).Range("AA3") = desicotes
For j = 1 To desicotes
Cells(10, j + 1).Borders.Value = 1
Cells(11, j + 1).Borders.Value = 1
Cells(12, j + 1).Borders.Value = 1
Cells(13, j + 1).Borders.Value = 1
Cells(14, j + 1).Borders.Value = 1
Cells(15, j + 1).Borders.Value = 1
Cells(16, j + 1).Borders.Value = 1
Cells(17, j + 1).Borders.Value = 1
Cells(18, j + 1).Borders.Value = 1
Cells(19, j + 1).Borders.Value = 1
Windows("1.xls").Activate
Sheets(1).Cells(6 + 2 * j, 3).Copy 'COPIE DENOMINATIONS
Windows(nom_fichier).Activate
Sheets(1).Cells(10, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Windows("1.xls").Activate
Sheets(1).Cells(6 + 2 * j, 6).Copy 'COPIE TOLERANCES SUPERIEURES
Windows(nom_fichier).Activate
Sheets(1).Cells(12, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Windows("1.xls").Activate
Sheets(1).Cells(6 + 2 * j, 5).Copy 'COPIE COTES NOMINALES
Windows(nom_fichier).Activate
Sheets(1).Cells(11, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Windows("1.xls").Activate
Sheets(1).Cells(7 + 2 * j, 6).Copy 'COPIE TOLERANCES INFERIEURES
Windows(nom_fichier).Activate
Sheets(1).Cells(13, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Next
Application.ScreenUpdating = False
For l = 1 To desicotes
Windows("1.xls").Activate
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Rectitude" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Rectitude" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Planéité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Planéité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Localisation d'un Plan" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Loca." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Localisation d'un Axe" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Loca." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Loca." Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Loca." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Inclinaison" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Inclinaison" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Battement radial" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Battement simple" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Tol. symétrie sur élément plan" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Sym." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Tol. symétrie sur élément axe" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Sym." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Tol. symétrie sur élément pt" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Sym." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Perpendicularité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Perpendicularité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Parallélisme" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Parallélisme" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Coaxialité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Coaxialité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Circularité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Circularité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Concentricité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Concentricité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Sphéricité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Sphéricité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Conicité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Conicité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Cylindricité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Cylindricité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value <> "Formules de calcul" Then
Windows(nom_fichier).Activate
Sheets(1).Cells(14, 1 + l).Value = "Tridim"
Windows("1.xls").Activate
End If
Next
Windows("1.xls").Close
Windows(nom_fichier).Activate
For k = 1 To desicotes
Cells(12, k + 1) = Cells(12, k + 1).Value + Cells(11, k + 1).Value
Cells(13, k + 1) = Cells(13, k + 1).Value + Cells(11, k + 1).Value
Next
'***ENREGISTREMENT DE LA TRAME************************************************************
Sheets(2).Activate
Sheets(2).Range("F5").Value = Sheets(3).Range("D4") 'désignation
Sheets(2).Range("F6").Value = Sheets(3).Range("D5") 'Client
Sheets(2).Range("F7").Value = Sheets(3).Range("D6") 'Code produit
Sheets(2).Range("H7").Value = Sheets(3).Range("F6") 'référence
Sheets(2).Range("F10").Value = Sheets(3).Range("D9") 'Plan de fab
Sheets(2).Range("F11").Value = Sheets(3).Range("D10") 'Indice fab
Sheets(2).Range("F20").Value = Sheets(3).Range("D16") 'Plan Spéc
Sheets(2).Range("F21").Value = Sheets(3).Range("D17") 'Indice Spéc
'Sheets(2).Range("F19").Value = Sheets(3).Range("D15") 'Fréquence
Sheets(2).Range("H22").Value = Sheets(3).Range("F18") 'long insert 1
Sheets(2).Range("H23").Value = Sheets(3).Range("F19") 'long insert 2
Sheets(2).Range("H24").Value = Sheets(3).Range("F20") 'long insert 3
ActiveWorkbook.SaveAs Filename:="W:\50-METROLOGIE\20-RAPPORTS\00-TRAMES\" & Sheets(1).Range("client") & "\" & Sheets(1).Range("code_produit") & " IND " & Sheets(1).Range("indice_trame") & ".xlsm"
Sheets(1).Range("cmd_cli").Value = ClearContents
Sheets(1).Range("cmd_int").Value = ClearContents
Sheets(1).Range("qte_cont").Value = ClearContents
Sheets(1).Range("qte_livre").Value = ClearContents
Sheets(1).Range("of").Value = ClearContents
Sheets(1).Range("lot_mat").Value = ClearContents
Sheets(1).Range("lot_grav").Value = ClearContents
Sheets(1).Range("date_rapport").Value = ClearContents
Sheets(1).Range("lot_tant_1").Value = ClearContents
Sheets(1).Range("lot_tant_2").Value = ClearContents
Sheets(1).Range("lot_tant_3").Value = ClearContents
Sheets(1).Protect Password:=("tramecfpla"), DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
Sheets(2).Protect ("tramecfpla")
Sheets(3).Protect ("tramecfpla")
Sheets(1).Unprotect ("tramecfpla")
Sheets(2).Visible = True
Sheets(3).Visible = xlHidden
Sheets(1).Visible = True
Sheets(2).Activate
APP = MsgBox("Voulez-vous approuver la trame ?", vbYesNo)
If APP = vbYes Then
Sheets(1).Visible = True
Sheets(1).Select
End If
Application.ScreenUpdating = True
Exit Sub
CreaTrame:
Sheets(3).Visible = True
Sheets(1).Visible = xlHidden
Sheets(2).Visible = xlHidden
Application.ScreenUpdating = True
End SubAncien qui fonctionne
Sub création_trame()
Application.ScreenUpdating = False
Sheets(1).Visible = -1
Sheets(2).Visible = -1
Sheets(3).Visible = 2
Dim nom_fichier As Variant
nom_fichier = "DOC N° 8 - 2 - 4 - 9 - d"
Sheets(1).Unprotect ("tramecfpla")
Sheets(2).Unprotect ("tramecfpla")
Sheets(3).Unprotect ("tramecfpla")
'***********************************************OUVERTURE DU FICHIER N°1 ET COPIE DES DESIGNATIONS DES CÔTES DANS UN AUTRE FICHIER***************************************
'***OUVERTURE DE FICHIER N°1 ET COPIE DES DESIGNATION DE COTES****************************
Workbooks.Open Filename:="W:\50-METROLOGIE\20-RAPPORTS\02-CLIENTS\" & Sheets(1).Range("client") & "\" & Sheets(1).Range("cmd_int") & "\" & Sheets(1).Range("code_produit") & "\N°OF" & Sheets(1).Range("of") & "\1.xls"
desicotes = 0
For i = 0 To 500
If Cells(8 + 2 * i, 3) <> "" Then
desicotes = desicotes + 1
Else
If Cells(10 + 2 * i, 3) <> "" Then
Windows(nom_fichier & ".xlsm").Activate
Exit For
End If
End If
Next
Windows(nom_fichier & ".xlsm").Activate
Sheets(2).Range("AA3") = desicotes
For j = 1 To desicotes
Cells(10, j + 1).Borders.Value = 1
Cells(11, j + 1).Borders.Value = 1
Cells(12, j + 1).Borders.Value = 1
Cells(13, j + 1).Borders.Value = 1
Cells(14, j + 1).Borders.Value = 1
Cells(15, j + 1).Borders.Value = 1
Cells(16, j + 1).Borders.Value = 1
Cells(17, j + 1).Borders.Value = 1
Cells(18, j + 1).Borders.Value = 1
Cells(19, j + 1).Borders.Value = 1
Windows("1.xls").Activate
Sheets(1).Cells(6 + 2 * j, 3).Copy 'COPIE DENOMINATIONS
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Windows("1.xls").Activate
Sheets(1).Cells(6 + 2 * j, 6).Copy 'COPIE TOLERANCES SUPERIEURES
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(12, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Windows("1.xls").Activate
Sheets(1).Cells(6 + 2 * j, 5).Copy 'COPIE COTES NOMINALES
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(11, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Windows("1.xls").Activate
Sheets(1).Cells(7 + 2 * j, 6).Copy 'COPIE TOLERANCES INFERIEURES
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(13, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
'Cells(10, 1 + j) = "='W:\tridim\Rapport\Client\" & Sheets(1).Range("client") & "\" & Sheets(1).Range("cmd_int") & "\" & Sheets(1).Range("code_produit") & "\N°OF" & Sheets(1).Range("of") & "\[1.xls]" & "1.xls'!$C" & 6 + 2 * j
'Cells(11, 1 + j) = "='W:\tridim\Rapport\Client\" & Sheets(1).Range("client") & "\" & Sheets(1).Range("cmd_int") & "\" & Sheets(1).Range("code_produit") & "\N°OF" & Sheets(1).Range("of") & "\[1.xls]" & "1.xls'!$E" & 6 + 2 * j
'Cells(12, 1 + j) = "='W:\tridim\Rapport\Client\" & Sheets(1).Range("client") & "\" & Sheets(1).Range("cmd_int") & "\" & Sheets(1).Range("code_produit") & "\N°OF" & Sheets(1).Range("of") & "\[1.xls]" & "1.xls'!$F" & 6 + 2 * j
'Cells(13, 1 + j) = "='W:\tridim\Rapport\Client\" & Sheets(1).Range("client") & "\" & Sheets(1).Range("cmd_int") & "\" & Sheets(1).Range("code_produit") & "\N°OF" & Sheets(1).Range("of") & "\[1.xls]" & "1.xls'!$F" & 7 + 2 * j
Next
For l = 1 To desicotes
Windows("1.xls").Activate
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Rectitude" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Rectitude" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Planéité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Planéité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Localisation d'un Plan" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Loca." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Localisation d'un Axe" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Loca." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Loca." Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Loca." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Inclinaison" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Inclinaison" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Battement radial" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Battement simple" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Tol. symétrie sur élément plan" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Sym." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Tol. symétrie sur élément axe" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Sym." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Tol. symétrie sur élément pt" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Sym." & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Perpendicularité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Perpendicularité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Parallélisme" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Parallélisme" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Coaxialité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Coaxialité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Circularité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Circularité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Concentricité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Concentricité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Sphéricité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Sphéricité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Conicité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Conicité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value = "Cylindricité" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(10, 1 + l).Value = "Cylindricité" & " " & Sheets(1).Cells(10, 1 + l)
Sheets(1).Cells(11, 1 + l).Value = 0
Sheets(1).Cells(13, 1 + l).Value = 0
Windows("1.xls").Activate
End If
If Sheets(1).Cells(7 + 2 * l, 3).Value <> "Formules de calcul" Then
Windows(nom_fichier & ".xlsm").Activate
Sheets(1).Cells(14, 1 + l).Value = "Tridim"
Windows("1.xls").Activate
End If
Next
Windows("1.xls").Close
Windows(nom_fichier & ".xlsm").Activate
For k = 1 To desicotes
Cells(12, k + 1) = Cells(12, k + 1).Value + Cells(11, k + 1).Value
Cells(13, k + 1) = Cells(13, k + 1).Value + Cells(11, k + 1).Value
Next
'***ENREGISTREMENT DE LA TRAME************************************************************
Sheets(2).Activate
Sheets(2).Range("F5").Value = Sheets(3).Range("D4") 'désignation
Sheets(2).Range("F6").Value = Sheets(3).Range("D5") 'Client
Sheets(2).Range("F7").Value = Sheets(3).Range("D6") 'Code produit
Sheets(2).Range("H7").Value = Sheets(3).Range("F6") 'référence
Sheets(2).Range("F10").Value = Sheets(3).Range("D9") 'Plan de fab
Sheets(2).Range("F11").Value = Sheets(3).Range("D10") 'Indice fab
Sheets(2).Range("F21").Value = Sheets(3).Range("D17") 'Plan Spéc
Sheets(2).Range("F22").Value = Sheets(3).Range("D18") 'Indice Spéc
Sheets(2).Range("F19").Value = Sheets(3).Range("D15") 'Fréquence
Sheets(2).Range("H23").Value = Sheets(3).Range("F19") 'long tantale 1
Sheets(2).Range("H24").Value = Sheets(3).Range("F20") 'long tantale 2
Sheets(2).Range("H25").Value = Sheets(3).Range("F21") 'long tantale 3
Sheets(2).Range("H26").Value = Sheets(3).Range("F22") 'long taitane 1
Sheets(2).Range("H27").Value = Sheets(3).Range("F23") 'long titane 2
Sheets(2).Range("H28").Value = Sheets(3).Range("F24") 'long titane 3
ActiveWorkbook.SaveAs Filename:="W:\50-METROLOGIE\20-RAPPORTS\00-TRAMES\" & Sheets(1).Range("client") & "\" & Sheets(1).Range("code_produit") & " IND " & Sheets(1).Range("indice_trame") & ".xlsm"
Sheets(1).Range("cmd_cli").Value = ClearContents
Sheets(1).Range("cmd_int").Value = ClearContents
Sheets(1).Range("qte_cont").Value = ClearContents
Sheets(1).Range("qte_livre").Value = ClearContents
Sheets(1).Range("of").Value = ClearContents
Sheets(1).Range("lot_mat").Value = ClearContents
Sheets(1).Range("lot_grav").Value = ClearContents
Sheets(1).Range("date_rapport").Value = ClearContents
Sheets(1).Range("lot_tant_1").Value = ClearContents
Sheets(1).Range("lot_tant_2").Value = ClearContents
Sheets(1).Range("lot_tant_3").Value = ClearContents
Application.ScreenUpdating = True
Sheets(1).Protect Password:=("tramecfpla"), DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
Sheets(2).Protect ("tramecfpla")
Sheets(3).Protect ("tramecfpla")
Sheets(1).Unprotect ("tramecfpla")
End Subj'en appel donc à vos lumières, si quelqu'un parmi vous voit la raison pour laquelle la MAJ de l'écran ne sait fait plus depuis les dernières modifs.
merci par avance
Bonjour,
Difficile de croire que
Application.ScreenUpdating = False
ne 'fonctionne' plus ...
A quel endroit ta macro s'arrête-t-elle ...???
E
Bonjour James007
Dans la "nouvelle" macro, "Application.ScreenUpdating = False" ne fonctionne pas du tout!!!
j'aurai bien mis le fichier afin que vous puissiez vous rendre compte par vous même mais comme la macro offre des fichiers sur mon serveur pour les copier dans un autre cela ne fonctionnerai pas d'où les copies de code
[quote="Elhadj"]
Dans la "nouvelle" macro, "Application.ScreenUpdating = False" ne fonctionne pas du tout !!!
/quote]
Désolé de ne pas pouvoir t'aider plus avant ...
Surtout que tu as l'air de dire ... que tu n'as aucun message d'erreur ...
E
Merci quand même James007 pour avoir essayé
je me demande s'il n'y a pas une histoire de version là dedans
Bonjour Elhadj,
Je confirme que c'est probablement une histoire de version, car Excel 2013 et Excel 2016
utilisent une nouvelle interface SDI (Single Document Interface).
Je pense que ce message de Patrice33740 avec une solution pourra t'aider :
http://www.commentcamarche.net/forum/affich-33931181-bug-affichage-suite-a-l-execution-du-code#3
Cordialement
@ dhany
Merci beaucoup pour cette info ... !!!
Je suis super curieux de savoir si cette solution va fonctionner ...
Car ... a priori ... d'après ton lien :
cela concerne Excel 2016 ...et Le problème semble lié à la nouvelle interface SDI apparue avec Excel 2013 ...
et Elhadj utilise Excel 2010 ....
E
Bonsoir les amis, merci pour vos retours. Je regarderai cela demain et reviendrai vers vous pour vous tenir au courant.
James007 la macro a été réalisée sous Excel 2007 puis modifié sous 2010 mais comme les utilisateurs utilisent différentes versions allant de 2007 à 2016, je me demande s'il n'y a pas eu de modifications avec une version récente.
Je vais creuser cette piste en tout cas demain matin et vous tiens au courant.
Bonne soirée à tous
E
Bonjour les amis,
@dhany, j'ai regardé la solution que tu m'as proposé mais je ne comprends pas comment elle marche et comment est-ce qu'elle pourrait régler mon problème
j'ai pensé à exporter les macro présentent dans mon dans l'ancien document pour les réiporter dans un nouveau document soux excel 2016 mais j'i des bugs que je ne comprends pas dés le début avec les lignes
Sheets(4).Visible=-1 qui n'est plus reconnu. J'ai remplacé par
Sheets(4).Visible= True mais j'ai toujours une erreur à cette ligne
N
Bonjour (..)
Une question (bête peut-être) es-tu certain d'avoir une feuille 4 ?
Par contre pour ce qui d'accélérer ton code tu peux déjà remplacer toutes les séries de
E
Bonjour NCC 1701
oui j'ai des feuilles 3 4 et 5 (j'ai copié les anciennes feuilles dans le nouveau classeur pour ne pas avoir à retaper toute la mise n forme)
Je souhaite si possible m’épargner de repartir de zéro.
E
NCC 1701 a écrit :Bonjour (..)
Une question (bête peut-être) es-tu certain d'avoir une feuille 4 ?
Par contre pour ce qui d'accélérer ton code tu peux déjà remplacer toutes les séries de
Est-ce que tu pourrai finir ta phrase stp
N
(re)
Oui je peux... j'ai juste cliquer trop vite... sur [Envoyer]
Je disais tu remplacer les
Sheets(n).Cells(....
'par des
With Sheets(n)
.Cells(....Cela devrait accélérer ton code
Par contre je reviens sur ma question "Es-tu certain d'avoir une feuille 4 ?"
Lorsque tu utilises Sheets( n ) => n représente le numéro "relatif" comment sont positionnés "visuellement les onglets" dans ton classeur, pas le nom qu'elle semble porter (si tu ne lui as pas donné de nom)
Tente ce test pour voir...
Sub test()
For x = 1 To Sheets.Count
MsgBox Sheets(x).Name & " " & Sheets(x).CodeName
Next
End Subtu n'auras pas forcément les correspondances auxquelles tu t'attends....
E
NCC 1701:
j'ai testé ton code et je tombe bien sur (3) (4) et (5)
N
(re)
Désolé, c'était une piste comme une autre... par contre j'ai bien fait de ne pas passer à 2016
Je passe mon tour
E
NCC 1701 a écrit :(re)
Désolé, c'était une piste comme une autre... par contre j'ai bien fait de ne pas passer à 2016
Je passe mon tour
Merci pour ton aide
Bonjour,
Si tu mets le doigt sur la solution ... Merci de la partager avec le Forum ...
Je suis très curieux de connaitre le fin mot de cette histoire ...
E
avec plaisir,
je vais commencer à refaire la macro de A à Z sur 2016 en espérant qu'avant que je finisse, quelqu'un me soufflera la solution
Bonjour,
tu confonds nom de feuille, index de feuille et codename de feuille.
Tu as 3 feuilles, donc les index ne peuvent aller que de 1 à 3
Pour la 2nde feuille ces notations sont équivalentes :
Sheets("rapport de contrôle") ' par le nom
Sheets(2) ' par l'index, elle est en 2nde position !!!
Feuil4 'par le codename, écrit à gauche du nom de la feuille dans le projet
et tu n'as pas de sheets(4)
eric
E
@eriiic,
je vais en rdv puis je teste ça rapidement
effectivement je ne connaissais pas la différence entre Sheets(2) et Feuil2, je pensais que c'était la même chose.
tu n'aurais pas une idée de la cause de mon problème originel