Discussion :

[coyote90]

Bonjour à tous,

J'ai une erreur numéro -2147417848 qui remonte sur une macro vba.
Malheureusement l'erreur n'est pas systématique.

sur les deux dernières occurences, le message remonté a été différent

Debug.Print err.Number , err.Description

-2147417848 Erreur Automation L’objet invoqué s’est déconnecté de ses clients.
-2147417848 La méthode 'ModifyAppliesToRange' de l'objet 'FormatCondition' a échoué

Avez-vous déjà eu ce cas, comment le gérez vous ?

merci d'avance.

[Nain porte koi]

Hello,

si vous voulez que l'on debugge une erreur mystérieuse il nous faudrait au moins le code mais pour tester le mieux serait le fichier (sans infos confidentielles)

[coyote90]

c'est bien la difficulté, j'ai l'impression que l'erreur vient d'un problème de mémoire.
anonymiser le fichier semble compliqué

Et je ne trouve pas de référence a ce numéro d'erreur.


voici le code, il semblerait que le blocage se fasse le plus souvent sur la ligne en rouge

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
Sub JcMFC_update()
' refonte des MFC
' les MFC testent la valeur de la colonne Ident 
'

Application.EnableEvents = False
Application.ScreenUpdating = False
If ScheduleEndCol = 0 Then Call JobCardInit(False)
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(myws)
ws.Activate
Call wsUnprotect(ws)

'Excel crashes if user do multiple clicks on New,Del,Up,Down buttons > check cursor state to avoid multiple clicks.
If Application.Cursor = xlWait Then Exit Sub
Application.Cursor = xlWait

'Afficher toutes les colonnes et toutes les lignes
ws.OutLine.ShowLevels RowLevels:=2, ColumnLevels:=2
ws.Rows(1).EntireColumn.Hidden = False

Dim mfcs As FormatConditions
Dim mfc As FormatCondition
Set mfcs = ws.UsedRange.FormatConditions
If mfcs.count <= 0 Then GoTo fin

Dim firstLig As Long: firstLig = HeaderLinNb + 6 '+ 3 ' Modèle de tâche
Dim lastLig As Long: lastLig = ws.Range(Cells(1, IdentCol), Cells(Rows.count, IdentCol)).Find(What:="PRE", Lookat:=xlWhole, MatchCase:=True).Row
Dim lastCol As Long: lastCol = ScheduleEndCol
Dim TplLig As Long: TplLig = 7 'ligne modèle pour reproduite les mises en forme conditionnelles


Dim strFormula1 As String: strFormula1 = ""
Dim strAppliesTo As String: strAppliesTo = ""

' effacer les MFC
On Error Resume Next
ws.Range(Cells(firstLig + 1, 1), Cells(lastLig, lastCol)).FormatConditions.Delete
On Error GoTo 0

Call ProtecOff
' changer le range des MFC d'origine
Dim i As Long
Dim PosLastDollarsSign As String: PosLastDollarsSign = ""
Dim newRng As String: newRng = ""

For i = mfcs.count To 1 Step -1
    
    On Error GoTo skipMfc
    Set mfc = mfcs(i)
    On Error GoTo 0
    
    Select Case mfc.Type
        Case 1, 2
            strFormula1 = mfc.Formula1
            strAppliesTo = mfc.AppliesTo.Address
            Dim strAppliesToOrig: strAppliesToOrig = mfc.AppliesTo.Address
            If Len(Trim(strAppliesTo)) > 0 And Len(Trim(strFormula1)) > 0 Then
                'Debug.Print strFormula1, strAppliesTo, newRng
                'trouve la ligne de fin et remplace par une nouvelle valeur
                '$A$1:$CK$20
                'PosLastDollarsSign = InStrRev(strAppliesTo, "$", -1, vbTextCompare)
                'newRng = Left(strAppliesTo, PosLastDollarsSign) & CStr(lastLig)
                Dim rngMultiple() As String
                rngMultiple = Split(strAppliesTo, ",", , vbTextCompare) 'le séparateur en vba est , et non ;
                Dim tmp As Long, strRng As String
                'If UBound(rngMultiple) > 1 Then Stop
                For tmp = LBound(rngMultiple) To UBound(rngMultiple) Step 1
                    strRng = rngMultiple(tmp)
                    PosLastDollarsSign = InStrRev(strRng, "$", -1, vbTextCompare)
                    If InStr(1, strAppliesTo, ":") > 0 Then 'cas où ce n'est pas une plage de données
                        If InStr(1, strFormula1, "=""TS""") > 0 _
                        Or InStr(1, strFormula1, "=""ST""") > 0 _
                        Or InStr(1, strFormula1, "=""PR""") > 0 _
                        Then
                            ' recréer la chaine $a$7:$a$100 même si découpage
                            If InStr(1, strFormula1, "JcDtNow") > 0 Then TplLig = 1
                            rngMultiple(tmp) = Range(Cells(TplLig, Range(rngMultiple(tmp)).Column), Cells(lastLig, Range(rngMultiple(tmp)).Column + Range(rngMultiple(tmp)).Columns.count - 1)).Address
                            'Debug.Print firstLig, strRng, rngMultiple(tmp)
                        Else
                            rngMultiple(tmp) = Left(strRng, PosLastDollarsSign) & CStr(lastLig)
                        End If
                        
                    Else
                        rngMultiple(tmp) = strRng
                    End If
                Next tmp
                newRng = Join(rngMultiple, ",")
                
                
    On Error GoTo eh
                If InStr(1, strFormula1, "Select ON") > 0 Then
                    mfc.Priority = 1
                    'mfc.ModifyAppliesToRange Range(Left(strAppliesTo, PosLastDollarsSign) & CStr(lastLig + 21))
10                    mfc.ModifyAppliesToRange Range(Cells(1, 1), Cells(lastLig + 21, lastCol))
                    'Dim tmpRng As Range
                    'Set tmpRng = Range(Cells(1, 1), Cells(lastLig + 21, lastCol))
                    'mfc.ModifyAppliesToRange Range(tmpRng) '20241023 - error, ModifyAppliesToRange can not use Cells()
                End If
                
                If InStr(1, strFormula1, "=""TS""") > 0 Then
                    'Debug.Print "TS", strFormula1, strAppliesTo, newRng, Split(strAppliesTo, ":")(0) & ":" & Split(newRng, ":")(1)
20                    mfc.ModifyAppliesToRange Range(newRng)
                End If
                
                If InStr(1, strFormula1, "=""ST""") > 0 Then
30                    mfc.ModifyAppliesToRange Range(newRng)
                End If
                
                If InStr(1, strFormula1, "=""PR""") > 0 Then
40                    mfc.ModifyAppliesToRange Range(newRng)
                End If
    On Error GoTo 0
            End If
        Case Else
            Debug.Print mfc.Type
            'Stop
    End Select
skipMfc:

Next

fin:
ws.OutLine.ShowLevels RowLevels:=2, ColumnLevels:=1
Application.EnableEvents = True
Application.Cursor = xlDefault
Application.ScreenUpdating = True

Exit Sub

eh:
Application.ScreenUpdating = True

If err.Number = -2147417848 Then
    Debug.Print "automation " & Now & " " & err.Number & vbCrLf & err.Description
Else
    Debug.Print Now & " " & err.Number & vbCrLf & err.Description
    MsgBox err.Number & vbCrLf & err.Description & vbCrLf & "ligne=" & Erl & vbCrLf & "i=" & i, vbCritical    
End If
Application.ScreenUpdating = False
Resume Next

End Sub

[Obsidian]

Bonjour,
Un réflexe à avoir avec les erreurs sous Windows est de les convertir en hexadécimal : -2147417848 → 0x80010108. Il s'agit donc de l'erreur « 0x10108 AUTOMATION ERROR: THE OBJECT INVOKED HAS DISCONNECTED FROM ITS CLIENTS », ce qui est déjà assez élevé et donc spécifique à un environnement.

En gros, cela signifie que deux composants logiciels communiquaient entre eux et que l'un d'eux a mis fin à la relation, ce qui est très vague. Cela peut être deux composants COM dans le même environnement, ou une connexion sous-jacente à une base de données par exemple… Le contexte dans lequel l'erreur se produit est donc très important. Ici, on lit que c'est en appelant « FormatCondition.ModifyAppliesToRange » que cela se produit.

C'est probablement dû au fait que l'élément sur lequel les modifications doivent s'appliquer n'existe au plus ou n'est plus accessible au moment de l'appel pour une raison à déterminer.

On trouve de nombreux exemples en faisant une recherche, par exemple ici. Dans un autre cas, l'utilisateur exploitait des volets figés en marge de la feuille et le focus était revenu sur la feuille principale. Ça suffisait à faire perdre la connexion avec l'élément, apparemment.

Bon courage.

[coyote90]

Merci pour cette piste.

j'ai tenté d'encapsuler mfc dans un with mfc [...] end with
j'ai ajouté set mavariable = Nothing pour libérer de la mémoire
sans plus de succès.

Je peux faire tourner la procédure plusieurs fois, et autour de la 4ème 5ème itération, l'erreur apparait... et excel se ferme après qq secondes.

[Valtrase]

Bonjour le fil,

coyote90, ce qui m'interpelle un peu c'est le Resume Next dans votre gestion d'erreur, même s'il est peu probable que cela vienne de là vous devriez quitter proprement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
fin:
    If Not ws Is Nothing Then
        ws.Outline.ShowLevels RowLevels:=2, ColumnLevels:=1
    Else
        Debug.Print "ws = "; TypeName(ws); " La variable (ws) à été perdue !"
    End If
    If Not mfcs Is Nothing Then Set mfcs = Nothing
    If Not ws Is Nothing Then Set ws = Nothing
 
    Application.EnableEvents = True
    Application.Cursor = xlDefault
    Application.ScreenUpdating = True
 
    Exit Sub
 
eh:
    If Err.Number = -2147417848 Then
        Debug.Print "automation " & Now & " " & Err.Number & vbCrLf & Err.Description
    Else
        Debug.Print Now & " " & Err.Number & vbCrLf & Err.Description
        MsgBox Err.Number & vbCrLf & Err.Description & vbCrLf & "ligne=" & Erl & vbCrLf & "i=" & i, vbCritical
    End If
 
    Resume fin
 
End Sub