Bonjour =E0 tous,
j'aimerai transmettre la feuille active excel via outlook aux
destinataires s=E9lectionn=E9s par une case =E0 cocher et repris dans la
feuille
par exemple en
a1 une case =E0 cocher et en b1 le destinataire
a2 '' '' ' ''' ' '' b2 le destinataire
.
.
.
A12 ''''''''''''''''''''''''''''''''''''''' b12 le
destinataire
pouvez-vous m'indiquer la macro n=E9cessaire ?
merci de r=E9pondre=20
Papone2
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
RGI
Bonjour
essaies ceci
'mettre en A1 l'adresse du destinataire Sub Mail_Every_Worksheet() Dim sh As Worksheet Dim wb As Workbook Dim strdate As String Dim MyArrIndex As Long Dim E_Mail_Count As Long Dim cell As Range Dim MyArr() As String Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If sh.Range("a1").Value Like "*@*" Then strdate = Format(Now, "dd-mm-yy h-mm-ss")
E_Mail_Count = sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants).Count ReDim MyArr(1 To E_Mail_Count) MyArrIndex = 1 For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants) If cell Like "*@*" Then MyArr(MyArrIndex) = cell.Value MyArrIndex = MyArrIndex + 1 End If Next ReDim Preserve MyArr(1 To MyArrIndex)
sh.Copy Set wb = ActiveWorkbook With wb .SaveAs sh.Name & " de " _ & ThisWorkbook.Name & " " & strdate & ".xls" .SendMail MyArr, _ "ici, C'est la ligne objet" .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End If Next sh Application.ScreenUpdating = True End Sub
salutations
RGI "freedo" a écrit dans le message de news:
Bonjour à tous, j'aimerai transmettre la feuille active excel via outlook aux destinataires sélectionnés par une case à cocher et repris dans la feuille par exemple en a1 une case à cocher et en b1 le destinataire a2 '' '' ' ''' ' '' b2 le destinataire . . . A12 ''''''''''''''''''''''''''''''''''''''' b12 le destinataire pouvez-vous m'indiquer la macro nécessaire ? merci de répondre Papone2
Bonjour
essaies ceci
'mettre en A1 l'adresse du destinataire
Sub Mail_Every_Worksheet()
Dim sh As Worksheet
Dim wb As Workbook
Dim strdate As String
Dim MyArrIndex As Long
Dim E_Mail_Count As Long
Dim cell As Range
Dim MyArr() As String
Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Worksheets
If sh.Range("a1").Value Like "*@*" Then
strdate = Format(Now, "dd-mm-yy h-mm-ss")
E_Mail_Count =
sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants).Count
ReDim MyArr(1 To E_Mail_Count)
MyArrIndex = 1
For Each cell In
sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)
If cell Like "*@*" Then
MyArr(MyArrIndex) = cell.Value
MyArrIndex = MyArrIndex + 1
End If
Next
ReDim Preserve MyArr(1 To MyArrIndex)
sh.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs sh.Name & " de " _
& ThisWorkbook.Name & " " & strdate & ".xls"
.SendMail MyArr, _
"ici, C'est la ligne objet"
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End If
Next sh
Application.ScreenUpdating = True
End Sub
salutations
RGI
"freedo" <affrat@belgacom.net> a écrit dans le message de news:
1146303123.217925.130330@u72g2000cwu.googlegroups.com...
Bonjour à tous,
j'aimerai transmettre la feuille active excel via outlook aux
destinataires sélectionnés par une case à cocher et repris dans la
feuille
par exemple en
a1 une case à cocher et en b1 le destinataire
a2 '' '' ' ''' ' '' b2 le destinataire
.
.
.
A12 ''''''''''''''''''''''''''''''''''''''' b12 le
destinataire
pouvez-vous m'indiquer la macro nécessaire ?
merci de répondre
Papone2
'mettre en A1 l'adresse du destinataire Sub Mail_Every_Worksheet() Dim sh As Worksheet Dim wb As Workbook Dim strdate As String Dim MyArrIndex As Long Dim E_Mail_Count As Long Dim cell As Range Dim MyArr() As String Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If sh.Range("a1").Value Like "*@*" Then strdate = Format(Now, "dd-mm-yy h-mm-ss")
E_Mail_Count = sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants).Count ReDim MyArr(1 To E_Mail_Count) MyArrIndex = 1 For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants) If cell Like "*@*" Then MyArr(MyArrIndex) = cell.Value MyArrIndex = MyArrIndex + 1 End If Next ReDim Preserve MyArr(1 To MyArrIndex)
sh.Copy Set wb = ActiveWorkbook With wb .SaveAs sh.Name & " de " _ & ThisWorkbook.Name & " " & strdate & ".xls" .SendMail MyArr, _ "ici, C'est la ligne objet" .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End If Next sh Application.ScreenUpdating = True End Sub
salutations
RGI "freedo" a écrit dans le message de news:
Bonjour à tous, j'aimerai transmettre la feuille active excel via outlook aux destinataires sélectionnés par une case à cocher et repris dans la feuille par exemple en a1 une case à cocher et en b1 le destinataire a2 '' '' ' ''' ' '' b2 le destinataire . . . A12 ''''''''''''''''''''''''''''''''''''''' b12 le destinataire pouvez-vous m'indiquer la macro nécessaire ? merci de répondre Papone2