Microsoft 365 La méthode Paste spéciale a échouée

[GUERET]

Bonsoir,
J'obtiens ce message quand j'ouvre une feuille de mon fichier. Je cherche une solution à ce casse tête. Que faire ? Merci

 

[TooFatBoy]

Essaye ceci :

1- Dans chaque feuille de GP mets cette macro :

Spoiler

Private Sub Worksheet_Activate()
    CopierVoitures
End Sub

2- Dans un module standard mets cette macro :

Spoiler

Sub CopierVoitures()
'
Dim MaForme As Shape
Dim rng As Range, Memoire As Range
Dim MonDecalageLigne
Dim W_cellule As Long, W_image As Long, Left_image As Long
Dim H_cellule As Long, H_image As Long, Top_image As Long

    Application.ScreenUpdating = False

    Set Memoire = ActiveCell

    ' Suppression de toutes les formes de la feuille active
    For Each MaForme In ActiveSheet.Shapes
        MaForme.Delete
    Next MaForme

    For Each MaForme In Feuil27.Shapes

        If MaForme.TopLeftCell.Column = 7 Or MaForme.TopLeftCell.Column = 8 Then

            MonDecalageLigne = Application.Match(Feuil27.Range("F" & MaForme.TopLeftCell.Row), ActiveSheet.Range("B5:B32"), 0)

            If Not IsError(MonDecalageLigne) Then

                Set rng = ActiveSheet.Range("C3").Offset(MonDecalageLigne, 0)   ' Détermine la cellule où l'image doit être collée
                MaForme.Copy                                                    ' Copie l'image
                rng.PasteSpecial                                                ' colle l'image

                ' Met la hauteur de l'image à la taille de la plage de cellules fusionnées moins quatre
                ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Height = rng.MergeArea.Height - 4
                ' Si l'image est plus large que la plage de cellules fusiionnées
                If ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Width > (rng.MergeArea.Width - 4) Then
                    ' Met la largeur de l'image à la taille de la plage de cellules fusionnées moins quatre
                    ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Width = rng.MergeArea.Width - 4
                End If

                ' Calcule la largeur de la plage de cellules fusionnées
                W_cellule = rng.MergeArea.Width
                ' Calcule la largeur de l'image
                W_image = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Width
                ' Calcule la demi-largeur de l'espace vide dans la plage de cellules fusionnées
                Left_image = (W_cellule - W_image) / 2
                ' Décale l'image pour la centrer horizontalement sur la plage de cellules fusionnées
                ActiveSheet.Shapes(ActiveSheet.Shapes.Count).IncrementLeft Left_image

                ' Calcule la hauteur de la plage de cellules fusionnées
                H_cellule = rng.Resize(3, 1).Height
                ' Calcule la hauteur de l'image
                H_image = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Height
                ' Calcule la demi-hauteur de l'espace vide dans la plage de cellules fusionnées
                Top_image = (H_cellule - H_image) / 2
                ' Décale l'image pour la centrer verticalement sur la plage de cellules fusionnées
                ActiveSheet.Shapes(ActiveSheet.Shapes.Count).IncrementTop Top_image

            End If

        End If

    Next MaForme

    If Not rng Is Nothing Then Set rng = Nothing
    Application.CutCopyMode = False
    Memoire.Select

End Sub

 

[jurassic pork]

Hello,
j'ai déjà eu ce type de souci , avec des copy ou des paste intensifs et j'avais vu quand réessayant les commandes cela passait. J'avais utilisé ce code pour réessayer une fonction lorsqu'elle échouait :

Function retryMethod(Obj As Object, MethodName, NbArgs, Optional Arg1, Optional Arg2, Optional Arg3)
Dim retryCount As Integer
retryCount = 0
retry:
                On Error GoTo ErrorHandler
                Select Case NbArgs
                    Case 0
                          retryMethod = CallByName(Obj, MethodName, VbMethod)
                     Case 1
                          retryMethod = CallByName(Obj, MethodName, VbMethod, Arg1)
                     Case 2
                          retryMethod = CallByName(Obj, MethodName, VbMethod, Arg1, Arg2)
                     Case 3
                          retryMethod = CallByName(Obj, MethodName, VbMethod, Arg1, Arg2, Arg3)
                End Select
                GoTo Fin
        
ErrorHandler:
                retryCount = retryCount + 1
                If retryCount <= 10 Then
                    'Sleep 20
                    Debug.Print "Retry " & MethodName & " : "; retryCount & " - Erreur: " & Err.Number
                    Resume retry
                Else
                    MsgBox "Erreur  Méthode " & MethodName & " essayée 10 fois."
                    Exit Function
                End If
Fin:
End Function

On fait jusqu'à dix essais et après on arrête. Si il y a plusieurs essais on affiche dans la fenêtre d'exécution du vba , ces essais.
Voici comment l'utiliser dans ton code :

retryMethod rng, "PasteSpecial", 0

A mettre à la place de ton

rng.PasteSpecial

Ami calmant, J.P