Boucle et envoi de mail
Bonjour à tous,
j'ai un fichier avec une macro qui me permet d'envoyer par mail un tableau Excel en pdf, ( ci joint ) ,
ce que je souhaiterai maintenant c'est qu'une fois le premier mail parti : la cellule u1 de l'onglet depart , aille chercher la valeur de la cellule =Total!B3 envoi le mail puis aille chercher la valeur de la cellule =Total!B4 puis aille chercher la valeur de la cellule =Total!B5 etc ... jusqu' a la dernière cellule vide de la colonne F de l'onglet Total.
J'ai cherché sur différents post du site mais jamais sans trouver vraiment ce que je voulais,
Est ce que vous pourriez m'aider ?
Merci à vous,
Cdt,
.... :(
personne pour m'aider ,
Bonjour,
Pour ma part, le fichier joint est difficile d'accès, idem pour le code VBA.
J'ai l'impression que la demande consiste simplement à réaliser une boucle de la colonne "B".
Ci-après, un point de départ qui parcourt et affiche les cellules en question.
A associer ensuite avec votre code d'envoi de mail.
Option Explicit
Sub boucle()
Dim i, imax As Integer
' Nombre de lignes à parcourir dans la colonne B
imax = Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets("Total").Range("B:B"))
' Boucle
For i = 1 To imax
' Affichage successif des valeurs des cellules
MsgBox (ThisWorkbook.Worksheets("Total").Range("B" & (i + 1)))
Next
End Sub
A vous lire,
Bonjour et merci pour votre retour ,
je ne comprends pas ou placé ce code, le voici en intégralité :
J'ai essayé de le mettre en début mais ca ne fonctionne pas... qu'est ce que vous entendez par difficile d'accès ?
Merci à vous encore,
Cdt,
Sub Envoi()
'
'Columns("G:J").Select
'Selection.EntireColumn.Hidden = True
Dim i, imax As Integer
' Nombre de lignes à parcourir dans la colonne B
imax = Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets("Total").Range("B:B"))
' Boucle
For i = 1 To imax
' Affichage successif des valeurs des cellules
MsgBox (ThisWorkbook.Worksheets("Total").Range("B" & (i + 1)))
Next
Dim i As Integer
DisplayJourSem = Range("u2").Value
Select Case DisplayJourSem
Case "Allemand"
Application.Union(Range("a1:a1"), Range("c1:c1"), Range("h1:h1"), Range("k1:k1"), Range("m1:m1")).Select
Selection.EntireColumn.Hidden = True
Range("P1:R1").Select
Case "Anglais"
Application.Union(Range("a1:a1"), Range("b1:b1"), Range("h1:h1"), Range("k1:k1"), Range("l1:l1")).Select
Selection.EntireColumn.Hidden = True
Range("P1:R1").Select
Case "Français"
Application.Union(Range("b1:b1"), Range("c1:c1"), Range("h1:h1"), Range("l1:l1"), Range("m1:m1")).Select
Selection.EntireColumn.Hidden = True
Range("P1:R1").Select
Case ""
MsgBox ("Pas de dimanche dans le tableau")
Case Else
MsgBox ("Mauvaise saisie dans la cellule a1")
End Select
Selection.EntireColumn.Hidden = True
Application.ScreenUpdating = False
'For i = 15 To 300
'If WorksheetFunction.Sum(Range("K" & i & ":P" & i)) = 0 Then Rows(i).EntireRow.Hidden = True
'Next i
'Fonctionne sous excel 2000-2013
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim NoSem As Integer 'xxxxx
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
NoSem = Range("N5").Value 'recup numero semaine
mail = Range("u3").Value
fournisseur = Range("U2").Value
client = Range("U1").Value
Set Sourcewb = ActiveWorkbook
'Copie la feuille active comme nouvelle feuille
ActiveSheet.Copy
Set destwb = ActiveWorkbook
'Désactiver fenêtre de compatibilité
Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
'----------------------------------------------------------------------------
TempFilePath = Environ$("temp") & "\"
TempFileName = client & " Semana " & NoSem
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf
On Error Resume Next
With OutMail
.To = mail
.CC = ""
.bcc = ""
.Subject = "OFFRE LEGROSBIO S" & NoSem & " - " & client
.Attachments.Add TempFilePath & TempFileName & ".pdf"
.Body = "Bonjour ,
'xxxxx
'send ' pour envoyer
.display 'pour visualiser
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & ".pdf"
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Columns("A:N").Hidden = False
End Sub
En fait au lieu que ce soit dans un msg box je voudrais que le nom du client s'affiche en cellule U1 de l'onglet départ,
Cdt,
Difficile d'accès au sens où le code n'est pas (ou peu) indenté et qu'il n'est pas décomposé en sous-fonctions / procédures.
Le msgbox était un exemple à adapter, mais cela dépend de votre niveau en VBA.
Cela donne ceci alors :
Sub boucle()
Dim i, imax As Integer
' Nombre de lignes à parcourir dans la colonne B
imax = Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets("Total").Range("B:B"))
' Boucle
For i = 1 To imax
' Affichage successif des valeurs des cellules
ThisWorkbook.Worksheets("depart").range("U1") = ThisWorkbook.Worksheets("Total").Range("B" & (i + 1)))
' Insérer ici les instructions d'envoi
Next
End Sub
Il faudrait alors, juste après cet ligne, appeler votre macro "envoi" sous réserve qu'elle fonctionne bien de cette manière.
Voici le code que j'obtiens :
Sub boucle2()
Dim i, imax As Integer
' Nombre de lignes à parcourir dans la colonne B
imax = Application.WorksheetFunction.CountA(ThisWorkbook.Worksheets("Total").Range("B:B"))
' Boucle
For i = 1 To imax
' Affichage successif des valeurs des cellules
ThisWorkbook.Worksheets("depart").Range("U1") = ThisWorkbook.Worksheets("Total").Range("B" & (i + 1))
' Insérer ici les instructions d'envoi
Call Envoi
Next
End Sub
et voici le message d'erreur :
Pourtant ma macro envoi , fait bien le travail mais uniquement pour la premiere ligne deja saisi,
Merci infiniment,
Cdt;
RAS désolé tout fonctionne correctement ,
merci encore vous êtes génial !!!!!
Ravi d'avoir pu vous aider