XL 2010 méthode range de l'objet worksheet a échoué

[arvin]

bonjour à tous , désolé par avance mais ce code fonctionnait très bien et depuis patatras.....
le principe : on a une feuille avec une liste de nom et mails, la macro va chercher si elle trouve un nom dans une feuille et lui envoyer un mail
pourriez vous débuger?
merciii
Public Sub WshAgents_RechercherInfosMails()

'----------------------------------------------------------------------------------------------------------------------------
' AGENTS : Recherche les informations (NomAgent, PrenomAgent, EmailAgent, HoraireAgent, PosteAgent) avant envoi des mails
'----------------------------------------------------------------------------------------------------------------------------

On Error GoTo Erreur

Dim MonOutlook As Object, MonMessage As Object, ZoneTableau As Name
Dim WshLendemain As Worksheet, Onglet As Worksheet
Dim NomAgent As String, PrenomAgent As String, EmailAgent As String, SecteurAgent As String, HoraireAgent As String, PosteAgent As String, NomZone As String

InitialisationDebutMacro

' Recherche de la feuille correspondant au planning du lendemain
For Each Onglet In ActiveWorkbook.Sheets
If ExistenceZone(Onglet, "DatePlanning") = True Then
If Onglet.Range("DatePlanning").Value = Date + 1 Then
Set WshLendemain = Sheets(Onglet.Name)
Exit For
End If
End If
Next Onglet

If WshLendemain.Name <> Empty Then

With WshAgents.Range("TableauAgents")

' Parcours de tous les agents dans le tableau de la feuille 'Liste agents'
For rAgent = 1 To .Rows.Count - 1

' Renseigne les informations sur l'agent
NomAgent = .Cells(rAgent, cAgents_Nom).Value
PrenomAgent = .Cells(rAgent, cAgents_Prenom).Value
EmailAgent = .Cells(rAgent, cAgents_Email).Value

' Parcours de tous les tableaux (zones nommées)
For Each ZoneTableau In ThisWorkbook.Names

' Si tableau (zone nommée) provient de la feuille 'Liste agents'
If ZoneTableau.Name Like WshLendemain.Name & "!Tableau*" And ZoneTableau.RefersTo Like "=" & WshLendemain.Name & "*" Then

' Récupération du nom du tableau
NomZone = Right(ZoneTableau.Name, Len(ZoneTableau.Name) - InStr(ZoneTableau.Name, "!"))

With WshLendemain.Range(NomZone)

' Parcours des colonnes (matin, après-midi) et lignes du tableau
For cZoneTableau = .Columns.Count - 1 To .Columns.Count ' colonne 4 à 5

For rZoneTableau = 1 To .Rows.Count

' Si agent trouvé dans le tableau (sans tenir compte des caractères spéciaux)
If NomAgent & " " & PrenomAgent = ChaineEpure(.Cells(rZoneTableau, cZoneTableau).Value, NomAgent & " " & PrenomAgent) And EmailAgent <> Empty Then

SecteurAgent = CorrespondanceSecteur(NomZone)
HoraireAgent = .Cells(0, cZoneTableau).Value
PosteAgent = .Cells(rZoneTableau, 1)

If Not (.Cells(rZoneTableau, cZoneTableau).Value Like "*Dép*") And Not (.Cells(rZoneTableau, cZoneTableau).Value Like "*dép*") _
And Not (.Cells(rZoneTableau, cZoneTableau).Value Like "*Dep*") And Not (.Cells(rZoneTableau, cZoneTableau).Value Like "*dep*") _
And Not (.Cells(rZoneTableau, cZoneTableau).Value Like "*Arr*") And Not (.Cells(rZoneTableau, cZoneTableau).Value Like "*arr*") Then

If .Cells(rZoneTableau, cZoneTableau).Value Like "*" & ChrW(64) & "*" Then

WshAgents_EnvoyerMail NomAgent, PrenomAgent, EmailAgent, SecteurAgent, HoraireAgent, PosteAgent, "11h -> 12h30"

Else

WshAgents_EnvoyerMail NomAgent, PrenomAgent, EmailAgent, SecteurAgent, HoraireAgent, PosteAgent, Empty

End If

End If

End If

Next rZoneTableau

Next cZoneTableau

End With

End If

Next ZoneTableau

Next rAgent

End With

End If

InitialisationFinMacro

Exit Sub

Erreur:

ErreurMacro "Mod_Agents/WshAgents_RechercherInfosMails"

End Sub

 

[sylvanu]

Bonsoir Arvin,
Utilisez les balises </> pour le code c'est plus lisible.

Si ça eût marché et que ça ne marche plus, c'est que quelque chose à changer.

Il a du mal à trouver "objet worksheet". Avez vous modifiez des noms de feuilles ? Supprimé ou rajouté des feuilles ? ....
Et essayez de nous dire sur quelle ligne le bug apparait. Lors de l'erreur vous avez surement une fenêtre avec le bouton débogage, ce qui vous donnera la ligne incriminée.
Sinon fournissez un fichier test, ce sera plus simple.

 

[arvin]

Bonsoir Arvin,
Utilisez les balises </> pour le code c'est plus lisible.

Si ça eût marché et que ça ne marche plus, c'est que quelque chose à changer.

Il a du mal à trouver "objet worksheet". Avez vous modifiez des noms de feuilles ? Supprimé ou rajouté des feuilles ? ....
Et essayez de nous dire sur quelle ligne le bug apparait. Lors de l'erreur vous avez surement une fenêtre avec le bouton débogage, ce qui vous donnera la ligne incriminée.
Sinon fournissez un fichier test, ce sera plus simple.

Merci beaucoup : ai pris un ancien fichier et tout fonctionne ....effectivement, des feuilles ont été rajoutées, je vais expertiser tranquillement merci encore

 

[Samson]

Si je peux me permettre de relancer le débat vu que j'ai le même problème.
je viens de me lancer dans VBA et je n'arrive pas à régler ce problème.

j'ai 2 feuilles, la 1ère a 3 colonnes : Activité, noms des responsables, mails des responsables.

Et la 2ieme feuille 2 colonnes : Nom responsable, mail responsable. ici on liste chaque agent et son mail

Dans la 1ere on répertorie les différentes activités et leurs différents responsables.
une activité peut avoir plusieurs responsables, onc plusieurs mails à affecter sur la 2ième colonne (mails des responsables).

j'ai pensé à faire un macro qui affecte automatiquement à la seconde colonne les mails, mais ceci me renvoie à cette erreur.

Si vous pouvez m'aider.
Merci à vous!

Sub affecterMail()
Dim xx As Integer, xy As Integer
Dim i As Integer, j As Integer
Dim valeurMailCv As String, valeurMailList As String

Set cv = ThisWorkbook.Sheets("Completed_version")
Set wbl = ThisWorkbook.Sheets("Lists")

Application.ScreenUpdating = False

xy = Application.CountA(wbl.Range("A2:A15"))
xx = Application.CountA(cv.Range("A2:A100"))
xx = xx + 5

For i = 2 To xy
valeurMailList = wbl.Range("A" & i).Value
For j = 7 To xx
valeurMailCv = cv.Range("A" & j).Value
If InStr(1, valeurMailCv, valeurMailList) Then

cv.Range("B" & j) = wbl.Range("B" & i).Value & ";"
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

 

[sylvanu]

Bonjour Samson,
Quelle erreur sur quelle ligne ?
Fournissez un fichier test, ce sera plus simple à comprendre.