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 |
Partager