re
Bonjour
tu fait simplement une gestion d'erreur
mais il me faut le code pour savoir ou mettre les commandes
cela dit je suis certain que l'on peut palier à ça en allégeant la procédure
en aménageant les commandes
Bonjour Patrick. je t'envoie une partie du code, et notamment la partie où le message apparait souvent (après un copy et avant un paste ---> Code en bleu ci-bat). Tu verrais j'ai mis des Do Events et Application.CutCopyMode = False, à plusieurs endroits pour essayer de résoudre ça.
Merci beaucoup.
Sub TEST_Calendrier()
Application.EnableEvents = False
Sheets("Tab Dyn").PivotTables("Tableau croisé dynamique1").RefreshTable
Application.EnableEvents = True
Worksheets("Tab Dyn").Range("K2:M80").ClearContents
SupprimeShape 'Lance les macros pour obtenir le nb de valeurs Uniques
UniquesSegment 'Lance les macros pour obtenir le nb de valeurs Uniques
UniquesBody
UniquesNameplate
Dim n As Long
n = Worksheets("Tab Dyn").Cells(4, 9)
If n > 50 Then
MsgBox ("Please shorten your selection, too many models are selected")
Exit Sub
End If
taillex = Worksheets("Tab Dyn").Cells(91, 26) 'Worksheets("Tab Dyn").Cells(17, 78) / Cells(6, 9).Value
tailley = Worksheets("Tab Dyn").Cells(11, 7) 'Cells(18, 78)
Dim Unit As Integer
Dim Liste As Integer
Dim Nameplate As String
Dim Body As String
Dim PrevBody As String
Dim PrevSegment As String
Dim PrevNameplate As String
Dim Segment As String
Dim Propulsion As String
Dim Hauteur As Long
Dim Prog As String
DerLigne = Worksheets("Tab Dyn").Range("G1048576").End(xlUp).Row
Worksheets("Tab Dyn").Activate
Hauteur = Worksheets("Tab Dyn").Cells(11, 7).Value
Positionx = 480 'X est la Position Verticale axe des ordonnées, hauteur
For i = 101 To DerLigne
Positionx = Worksheets("Tab Dyn").Cells(i, 15)
Positiony = Worksheets("Tab Dyn").Cells(i, 21) '311 Y est la position horizontale axe des absisses
'For j = 15 To 15
Application.CutCopyMode = False
'On Error Resume Next
If Worksheets("Tab Dyn").Cells(i, 15).Value <> 0 And Worksheets("Tab Dyn").Cells(i, 16).Value <> "" Then
Nameplate = Worksheets("Tab Dyn").Cells(i, 10).Text 'Col Nameplate
Propulsion = Worksheets("Tab Dyn").Cells(i, 14).Value
Prog = Worksheets("Tab Dyn").Cells(i, 12).Value
Worksheets("Planning").Activate
'ActiveSheet.Shapes("Hachurage" & (j - 22)).Select
If Propulsion = "ICE" Then ActiveSheet.Shapes("ICE").Select
If Propulsion = "ICE & Electric" Then ActiveSheet.Shapes("ICEElec").Select
If Propulsion = "ICE & Electric & Hybrid" Then ActiveSheet.Shapes("ICEElecHybr").Select
If Propulsion = "ICE & Hybrid" Then ActiveSheet.Shapes("ICEHybr").Select
If Propulsion = "Electric & Hybrid" Then ActiveSheet.Shapes("ElecHybr").Select
If Propulsion = "Electric" Then ActiveSheet.Shapes("Elec").Select
If Propulsion = "Hybride" Then ActiveSheet.Shapes("Hybr").Select
If Propulsion = "Check" Then ActiveSheet.Shapes("Model").Select
End If
Application.CutCopyMode = False
DoEvents
'Application.CutCopyMode = False
Selection.Copy
DoEvents
ActiveSheet.Paste
Selection.ShapeRange.Name = "Nameplate" & i
Selection.ShapeRange.Left = Positiony
Selection.ShapeRange.Top = Positionx
Selection.ShapeRange.Width = Worksheets("Tab Dyn").Cells(i, 20).Value 'Longueur du rectangle
Selection.ShapeRange.Height = Worksheets("Tab Dyn").Cells(11, 7).Value
With Selection.ShapeRange.TextFrame
.Characters.Text = Nameplate & " (" & Prog & ")"
.Characters.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Application.CutCopyMode = False
Next i