erreur 2147417848

[pakalom]

bonsoir lorsque je lance cette macro suivante, j'ai une erreur 2147417848, erreur automation, l'objet invoqué s'est déconnecté de ses clients et je ne comprends pas pourquoi. Si vous pouviez m'aider ça me serait d'un grand secours .
Application.ScreenUpdating = False
Sheets("boissons").Select
Range("y23").Select
If ActiveCell.Value = 0 Then

MsgBox (" Impossible de valider ta demande,il n'y pas de conso saisies"), 48, "Casino Barrière De Dinard - information"
ComboBox1.SetFocus

Else




Msg = "Voulez vous vraiement faire une remise à zéro?" ' Définit le message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Définit les boutons.
Title = "confirmation de Remise à zéro" ' Définit le titre.
Help = "" ' Définit le fichier d'aide.
Ctxt = 1000 ' Définit le contexte de
' la rubrique.
'Affiche le message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' L'utilisateur a choisi Oui.
MyString = "Oui"
'Effectue une action.

Sheets("boissons").Select
Range("x23:y23").Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=8
Range("ae9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("ae9:af9").Select
Selection.Copy
Range("ae11").Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False





Range("ae9:af9").Select
Selection.ClearContents

Range("y26:y500").Select
Selection.ClearContents

Range("x21").Select
ActiveCell.FormulaR1C1 = 0

Range("x21").Select
Selection.Copy
Range("ah4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("ae10:af2000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("ah3:ai4"), CopyToRange:=Range("ah10:ai20000"), Unique:=False

Range("z9").Select
Selection.Copy
Range("z10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False




End If
End If

End Sub

 

[jpb388]

Re : erreur 2147417848

Bonjour

Help = "" ' Définit le fichier d'aide.
Ctxt = 1000 ' Définit le contexte de

il faut virer ces deux ligne, on met un contexte que si le help est défini hors là le help=""
si malgré cela l'erreur est toujours là mettre ton classeur en ligne
a+

 

[Gorfael]

Re : erreur 2147417848

Salut pakalom et le forum
Utilise les balises de code (icone # en mode avancé)
Ne connaissant rien d'autre que ce que tu nous donnes, difficile de trouver autre chose que la réponse précédente.
Ton code, non testé, avec un petit lifting :

Application.ScreenUpdating = False
If Sheets("boissons").Range("y23") = 0 Then
    MsgBox (" Impossible de valider ta demande,il n'y pas de conso saisies"), 48, "Casino Barrière De Dinard - information"
    ComboBox1.SetFocus
Else
    Msg = "Voulez vous vraiement faire une remise à zéro?" ' Définit le message.
    Style = vbYesNo + vbCritical + vbDefaultButton2 ' Définit les boutons.
    Title = "confirmation de Remise à zéro" ' Définit le titre.
    'Affiche le message.
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    If Response = vbYes Then ' L'utilisateur a choisi Oui.
        MyString = "Oui"
        'Effectue une action.
        'Sauvegarde des données
        Sheets("boissons").Range("x23:y23").Copy
        Sheets("boissons").Range("ae9").PasteSpecial Paste:=xlPasteValues
        Sheets("boissons").Range("ae9:af9").Copy
        Sheets("boissons").Range("ae11").Insert Shift:=xlDown
        'remise à zéro
        Sheets("boissons").Range("ae9:af9, y26:y500").ClearContents
        Sheets("boissons").Range("x21") = 0
        'Sheets("boissons").Range("x21").Copy
        'Sheets("boissons").Range("ah4").PasteSpecial Paste:=xlPasteValues
        Sheets("boissons").Range("ah4") = 0
        
        Sheets("boissons").Range("ae10:af2000").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("ah3:ai4"), CopyToRange:=Range("ah10:ai20000"), Unique:=False

        'Sheets("boissons").Range("z9").Copy
        'Sheets("boissons").Range("z10").PasteSpecial Paste:=xlPasteValues
        Sheets("boissons").Range("z10") = Sheets("boissons").Range("z9")
        Application.CutCopyMode = False
    End If
End If
End Sub

J'ai laissé certaines instructions inutiles, en les passant en commentaires et en mettant une proposition à la ligne du dessous.
On pourrait remplacer tout les préfixes Sheets par un unique With. mais n'ayant qu'une partie du code...
A+

 

[pakalom]

Re : erreur 2147417848

bonsoir,
j'ai mis la formule et merci je n'ai plus de pb.

merci encore