Bonjour,
J'ai remplacé "call" et "add" pour cause de problème et donc on m'a conseillé de remplacé par "try" et "cash". Mais j'ai une erreur de "sub ou fonction non définie " sur le try...
Je vous joint le code!
Private Sub AddRecipient(ByVal Destinataire As String, ByRef ObjMail As Object)
If Destinataire <> vbNullString Then try ObjMail.Recipients.cash(Destinataire)
End Sub
Si tu avais regardé l'aide et réfléchis un peu, tu aurais trouvé un code ressemblant à ça :
Private Sub AddRecipient(ByVal Destinataire As String, ByRef ObjMail As Object)
Try
If Destinataire <> vbNullString Then Call ObjMail.Recipients.Add(Destinataire)
Catch es As Exception
'Erreur
End Try
End Sub
Option Explicit
'Ajoute une feuille au classeur si elle n'existe pas déjà
'sinon active la feuille demande et efface le contenu
Private Function AddSheetIfNotExist(ByVal SheetName As String) As Worksheet
Dim ws As Worksheet
Dim Found As Boolean
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = SheetName Then
Found = True
'on efface cette feuille pour test
ws.Cells.ClearContents
Set AddSheetIfNotExist = ws
End If
Next
If Not Found Then
'ajoute la nouvelle feuille à la suite des autres
Set ws = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = SheetName
Set AddSheetIfNotExist = ws
End If
End Function
Sub Vérification_générale()
Dim NumLigne As Integer
Dim NumColonne As Integer
Dim j As Integer
Dim nom As String
'garde une référence sur la feuille de vérification
Dim WSVerif As Worksheet
'garde une référence sur la feuille de retard actuelle
Dim WSRetard As Worksheet
'création d'une nouvelle feuille contenant les retards
Set WSRetard = AddSheetIfNotExist("retard au " & DateTime.Date$)
Set WSVerif = Sheets("Vérif")
With WSRetard
.Activate
Call .Columns("A:K").Select
'largeur de la colonne de la nouvelle feuille
Selection.ColumnWidth = 15.71
'je mets les noms aux colonnes
Call WSVerif.Range("B1:K1").Copy
'sélection la cellule B1 avant de coller le contenu de B1:K1
Call .Range("B1").Select
Call .Paste
.UsedRange.Rows(1).EntireRow.Select
Selection.Orientation = 90
Selection.RowHeight = 97.5
Selection.WrapText = True
End With
NumLigne = 4 'première ligne d'agence
'pour chaque colonne
For NumColonne = 2 To 11
' tant qu'il y a des agences dans la colonne
While Not IsEmpty(WSVerif.Range("A" & NumLigne))
'je test si la case est vide, puisque dans ce cas le calcul ne doit pas être fait
If Not IsEmpty(WSVerif.Cells(NumLigne, NumColonne)) Then
'pour chaque agence, je test la date
If WSVerif.Range("L27").Value > WSVerif.Cells(NumLigne, NumColonne).Value + WSVerif.Cells(3, NumColonne).Value Then
'si la date est passé, je change la couleur de la case
Sheets("Vérif").Cells(NumLigne, NumColonne).Interior.ColorIndex = 3
'puis je met le nom de l'agence en question dans le tableau de la nouvelle feuille à la première case vide
WSRetard.Cells(2, NumColonne).Select
j = Selection.End(xlDown).Row + 1
WSRetard.Cells(j, NumColonne).Value = WSVerif.Range("A" & NumLigne).Value
End If
End If
' j'incrémente la variable de boucle
NumLigne = NumLigne + 1
Wend
NumLigne = 4 'on remet le compteur à la première ligne
Next NumColonne
WSRetard.Range("A1").Select
Call envoi_mail(WSVerif, WSRetard)
Set WSRetard = Nothing
Set WSVerif = Nothing
End Sub
Public Sub envoi_mail(ByRef WSVerif As Worksheet, ByRef WSRetard As Worksheet)
Dim corps As String
Dim NumColonne
Dim NumLigne As Integer
Dim olApp As Object
Dim ligne As Integer
Dim NomAgence As String
Dim ObjMail As Object
NumLigne = 4 'première ligne d'agence
' pour chaque agence, on cherche quelles colonnes sont en retard
Set olApp = CreateObject("Outlook.Application")
While Not IsEmpty(WSVerif.Range("A" & NumLigne).Value)
NomAgence = WSVerif.Range("A" & NumLigne).Value
'le corps du message est contenu dans la variable "corps"
corps = "Mesdames et Messieurs, Veuillez trouver ci-après la liste des vérifications périodiques en retard dans votre agence.
" & _
"Si aucune liste présente ci-dessous, vos visites périodiques sont donc à jour.
"
For NumColonne = 2 To 11
ligne = 2
While Not IsEmpty(WSRetard.Cells(ligne, NumColonne))
'si c'est l'agence à laquelle on souhaite ecrire
If WSRetard.Cells(ligne, NumColonne) = NomAgence Then
'on ajoute l'entete de colonne (la raison du retard)
corps = corps & Sheets(Worksheets.Count).Cells(1, NumColonne) & "
"
End If
ligne = ligne + 1
Wend
Next NumColonne
corps = corps & "Merci de bien vouloir réguler la situation, si nécessaire, " & _
"dans les plus brefs délais et/ou nous transmettre une copie du rapport de vérification.
" & _
"Merci de vérifier les dates de vos prochaines visites.
Cordialement, Service QSE " & _
"Message généré automatiquement, pour toute remarque appeler le service prévention au 04.74.08.90.64"
Set ObjMail = olApp.CreateItem(0)
'récupère et ajoute en destinaire le mails des responsables de chaque boites
Call AddRecipient(Sheets("adresses mail").Cells(NumLigne - 3, 2), ObjMail)
Call AddRecipient(Sheets("adresses mail").Cells(NumLigne - 3, 2), ObjMail)
Call AddRecipient(Sheets("adresses mail").Cells(NumLigne - 3, 2), ObjMail)
ObjMail.Subject = "retard vérification(s) périodique(s)"
ObjMail.htmlbody = corps
ObjMail.ReadReceiptRequested = False
ObjMail.Send
NumLigne = NumLigne + 1
Wend
Set ObjMail = Nothing
Set olApp = Nothing
End Sub
Private Sub AddRecipient(ByVal Destinataire As String, ByRef ObjMail As Object)
If Destinataire <> vbNullString Then Call ObjMail.Recipients.Add(Destinataire)
End Sub
Il est écrit en VB, il constitue une macro qui est opérationnel sous excel.
Je travail sous office 2007.
Son but est de trié un tableau, de créer une nouvelle page excel, puis d'envoyer des mails.
Je nage en VB... je n'y comprend pas grand chose!!
HELP ME
a aidé 88 internautes ce mois-ci