1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
| Sub RecupererDataFichier()
'Déclaration des variables
Dim Listefichier As Variant
Dim ws_data As Worksheet
Dim Onglet As Worksheet
Dim Monclasseur As Workbook
Dim derniere_ligne As Long
Dim dernire_colonne As Long
'Désactiver le presse-papier pour éviter le stockage et Raffraichissement de l'écran
Application.CutCopyMode = False
Application.ScreenUpdating = False
'Effacer les anciennes données
ActiveSheet.Range("A8").CurrentRegion.Clear
'Récupérer le fichier des données à copier
Listefichier = Application.GetOpenFilename(Title:="Sélectionner un fichier", _
filefilter:="Fichiers Excel(*.xls*),*xls*", ButtonText:="Cliquez")
'Prévoir le cas du bouton annuler
If Listefichier <> False Then
'Affecter le fichier sélectionné
Set Monclasseur = Application.Workbooks.Open(Listefichier)
'Copier les données de la feuille du classeur sélectionné
Monclasseur.Sheets("sheet1").Range("X1:X10000,S1:S10000,Y1:Y10000,C1:C10000,F1:F10000,H1:H10000,M1:M10000,B1:B10000,AB1:AB10000").Copy
'Coller les données dans la feuille active
ThisWorkbook.ActiveSheet.Range("A8").PasteSpecial Paste:=xlPasteAll
'Désactiver les messages d'alerte de Microsoft
Application.DisplayAlerts = False
'Fermer le classeur source
Monclasseur.Close
End If
'SuppDoublonsMail Macro
Range("J9").Select
ActiveCell.FormulaR1C1 = _
"=IF(IF(COUNTIF(R9C9:RC[-1],RC[-1])>1,"""",RC[-1])="""","""",RC[-1])"
Range("J9").Select
Selection.AutoFill Destination:=Range("J9:J302")
Range("J9:J302").Select
Selection.Copy
Range("I9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("J9").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
end sub[/COLOR][/I]
[INDENT][COLOR=#0000ff]Sub EnvoyerEmail()
' selectionner la feuille de calcul "sheet1"
Sheets("Data").Select
' EnvoyerEmail Macro
Dim leMail As Variant
Dim Ligne As Integer
Dim oOutlook As Object
Set oOutlook = CreateObject("Outlook.Application")
Dim oMail As Object
Set oMail = oOutlook.CreateItem(0)
Dim cel As Variant
'création d'un objet Outlook
Set leMail = CreateObject("Outlook.Application")
For Ligne = 9 To 10
With leMail.CreateItem(olMailItem)
'Dim oObjetWord As Object
'Set oObjetWord = .GetInspector.WordEditor
For Each cel In Range("I9:I" & Range("I9").End(xlDown).Row)
.Subject = "Réception des PO OBS à faire dans x-tracker " & Range("A" & Ligne)
.To = cel
.CC = "orders.obs@orange.com"
.Body = "Bonjour" & vbCr & " " & vbCr & "Merci de réceptionner vos commandes, afin de mettre les factures de vos fournisseurs en paiement." & vbCr & " " & vbCr & "Merci d'avance !" & vbCr & " " & vbCr & "Equipe Finance"
'Range("Tableau2").Select
'Selection.Copy
'oObjetWord.Range(100).Paste
.Display
'.Send
'leMail.Quit
'Set oleMail = Nothing
'Set oMsg = Nothing
'MsgBox "Mails Envoyés"
End With
Set email = Nothing
'Next cel
Next Ligne
End Sub |
Envoi de mail automatique
Répondre avec citation
Envoyé par User
.
Partager