[VBA] Erreur automation

Bonjour,

Je rencontre, sur un fichier xlsm qui fonctionnait très bien jusqu'à présent, l'erreur suivante :

Erreur d'exécution '-2147319767 (80028029)'

Erreur Automation
Référence future non valide, ou référence à un type non compilé.

L'erreur intervient dans la macro suivante :

Public Sub Envoi_STL(l As Integer)
    Dim Position As Range, PositionR2E As Range, PositionDep As Range
    Dim Mail As Object, objOFS As Object
    Dim Message As String, Destinataire As String, copie As String, PDR As String, IGS As String, adresse As String
    If ThisWorkbook.ActiveMacro = True Then
        IGS = Range("Z" & l)
        PDR = Range("A" & l) & ".pdf"
        adresse = ThisWorkbook.Path & "\06_Traitement_STL\" & PDR
        Set Mail = CreateObject("Outlook.Application").CreateItem(0)
        Set Position = Sheets("Contact").Range("A1:A200").Find(IGS, lookat:=xlWhole)
        Set PositionR2E = Sheets("Liste").Range("F1:F10").Find(Range("AA" & l).Text, lookat:=xlWhole)   '<==== ERREUR SUR CETTE LIGNE
        Set PositionDep = Sheets("Département").Range("A1:A12").Find(Range("B" & l), lookat:=xlWhole)
        Set objOFS = CreateObject("Scripting.FileSystemObject")
        Message = "<font size=3,5 face=""Arial"">" _
            & "Bonjour,<BR>" _
            & "<BR>" _
            & "Une nouvelle " & "<A href=" & Replace(adresse, " ", "%20") & ">PDR</A>" & " est disponible pour signature<BR>" _
            & "<i> veuillez signer la PDR sans changer le nom du document, ni son emplacement</i><BR>" _
            & "<BR>" _
            & "Cordialement,"
        copie = "contratmaintenance@G2M.fr; "
        Select Case Range("B" & l)
            Case "RAD"
                Destinataire = Sheets("Contact").Range("C" & Position.Row)
                copie = "CAD-EER-Maintenance@G2M.fr; " & copie
            Case "RADPVI"
                Destinataire = Sheets("Contact").Range("C" & Position.Row)
                copie = "EER-Maintenance@G2M.fr; " & copie
            Case "MEM"
                Destinataire = Sheets("Contact").Range("B" & Position.Row)
                If Range("L" & l) > 5000 And Not PositionDep Is Nothing Then Destinataire = Destinataire & "; "
                If Not PositionR2E Is Nothing Then copie = copie & Sheets("Liste").Range("G" & PositionR2E.Row)
            Case Else
                MsgBox ("Erreur dans la référence du contrat")
                Exit Sub
        End Select
        With Mail 'Ecrit le mail
            .display
            .Subject = "[CIM-PDR] : " & IGS & " - " & Range("A" & l).Value
            .htmlBody = Message & Mail.htmlBody
            .To = Destinataire
            .CC = copie
        End With
    End If
End Sub

En fonction de l'intervenant renseigné en colonne AA de mon tableau de données, il récupère la position dans un tableau de mes correspondants (onglet "Liste") pour retourner l'adresse mail associée. Cette macro, publique, est déclenchée par une macro Private Sub Worksheet_SelectionChange(ByVal Target As Range) placée dans chaque onglet annuel (le tableau de données est annuel, j'ai donc un onglet 2019, 2020, ..., 2024).

J'ai tenté de modifier la macro pour remplacer la ligne concernée :

Set PositionR2E = Sheets("Liste").Range("F1:F10").Find(Range("AA" & l).Text, lookat:=xlWhole)

par

Set PositionR2E = Sheets("Liste").Range("F1:F10").Find(R2E, lookat:=xlWhole)

avec par une variable string appelée R2E. La variable récupère bien la valeur demandée mais cela conduit toujours à la même erreur sur la même ligne.

Merci d'avance pour vos pistes, conseils, aides, solutions ! :)

Bonjour,

Sauf erreur de ma part, il manque l'instance Outlook. Il vous faut créer cette instance pour créer votre mail.

Exemple :

 Dim OlApp As Object, myItem As Object

     Set OlApp = CreateObject("Outlook.Application")
     Set myItem = OlApp.CreateItem(1)

Bonjour,

Merci pour votre retour. Est-ce que cela ne correspond pas à la l'instance Outlook (sur une seule ligne) ?

    Dim Mail As Object, objOFS As Object

        Set Mail = CreateObject("Outlook.Application").CreateItem(0)
        Set objOFS = CreateObject("Scripting.FileSystemObject")

Je ne suis pas la personne qui a écrit ce code, alors je ne sais pas si cela est fondamentalement différent de votre proposition !

Bonjour à tous.

Il n'y a pas d'autres conseils disponibles ?

Merci.

bonjour,

ton fichier est probablement corrompu.

crée un nouveau classeur, recopies-y tes feuilles et les macros et vérifie si tu as encore l'erreur.

bonjour le fil,

un essai en isolant ce règle, que ce passe-t-il quand vous lancer la macro "test" dans la même feuille de l'erreur et avec le même l ???

Sub Test()
     Test1 100                               'vous cherchez la valeur de quelle cellule AA ??? ici AA100 mais à modifier
End Sub

Sub Test1(l As Integer)
     Dim r, PositionR2E As Range
     MsgBox "ligne " & l & vbLf & "cellule " & Range("AA" & l).Address & vbLf & "Valeur : " & Range("AA" & l).Value & vbLf & "Feuille actuelle : " & ActiveSheet.Name
     r = Application.Match(Range("AA" & l).Value, Sheets("Liste").Range("F1:F10"), 0)     '<==== ERREUR SUR CETTE LIGNE lookat:=xlWhole)   '<==== ERREUR SUR CETTE LIGNE
     If IsNumeric(r) Then
          MsgBox "F" & r
     Else
          MsgBox "inconnu"
     End If

     Set PositionR2E = Sheets("Liste").Range("F1:F10").Find(Range("AA" & l).Text, lookat:=xlWhole)     '<==== ERREUR SUR CETTE LIGNE
     If PositionR2E Is Nothing Then MsgBox "problème"
End Sub

Bonjour à tous,

@YanLe Flan,

Je viens d'avoir le même message d'erreur que toi sur un de mes classeurs.

j'ai appliqué la méthode que je t'ai proposée, cela a résolu le problème. Par contre, la cause reste inconnue.

Bonjour,

Finalement, après déroulé de la solution proposée par h2so4, plus de problème.

Merci à tous. Le post peut être soldé.