djkrom2003
XLDnaute Nouveau
bonjour.
pourriez vous m'aider,je suis coincé avec ce fichier,
J'ai dans un premier temps une macro qui traite des infos et qui l'enregistre selon la date du jour, puis, toujours dans la même macro je lui demande d'envoyer en automatique le fichier traité. hors, je recoit bien le fichier, mais le fichier avant traitement.... et je bloque à ce niveau.
je vous joint le fichier pour essai en vous remerciant d'avance de l'aide apportée.
pourriez vous m'aider,je suis coincé avec ce fichier,
J'ai dans un premier temps une macro qui traite des infos et qui l'enregistre selon la date du jour, puis, toujours dans la même macro je lui demande d'envoyer en automatique le fichier traité. hors, je recoit bien le fichier, mais le fichier avant traitement.... et je bloque à ce niveau.
je vous joint le fichier pour essai en vous remerciant d'avance de l'aide apportée.
Code:
Option Explicit
Sub tri_adv()
'
' tri_adv Macro
' Macro modifiée le 26/01/2012 par Lopes-Gu
'
Dim Monfichier, Jour, Question
'
Selection.AutoFilter Field:=12, Criteria1:="BRESSAT"
Range("L1").Select
Selection.Copy
Sheets("Feuil5").Select
Sheets("Feuil5").Name = "BRESSAT"
Sheets("Feuil1").Select
Range("L1").CurrentRegion.Rows.Select
Range("A1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("BRESSAT").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("Feuil1").Select
Selection.AutoFilter Field:=12, Criteria1:="CHARPENTIER"
Range("L1").Select
Selection.Copy
Sheets("Feuil3").Select
Sheets("Feuil3").Name = "CHARPENTIER"
Sheets("Feuil1").Select
Range("L1").CurrentRegion.Rows.Select
Range("L1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("CHARPENTIER").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("Feuil1").Select
Selection.AutoFilter Field:=12, Criteria1:="GRUNY"
Range("L1").Select
Selection.Copy
Sheets("Feuil4").Select
Sheets("Feuil4").Name = "GRUNY"
Sheets("Feuil1").Select
Range("L1").CurrentRegion.Rows.Select
Range("L1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("GRUNY").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("Feuil1").Select
Selection.AutoFilter Field:=12, Criteria1:="SONRIER"
Range("L1").Select
Selection.Copy
Range("A1").Select
Sheets("Feuil6").Select
Sheets("Feuil6").Name = "SONRIER"
Sheets("Feuil1").Select
Range("L1").CurrentRegion.Rows.Select
Range("L1").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("SONRIER").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("Feuil1").Select
Selection.AutoFilter Field:=12, Criteria1:="Non affecté"
Sheets("Feuil7").Select
Sheets("Feuil7").Name = "NON_Affecté"
Sheets("Feuil1").Select
Range("L1").CurrentRegion.Rows.Select
Selection.Copy
Sheets("NON_Affecté").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFilter
'demande d'enregistrement d'automatique
Question = MsgBox("Voulez vous enregistrer automatiquement le fichier?", vbYesNo + vbQuestion + vbDefaultButton2, "")
If Question = 6 Then
On Error Resume Next
MkDir "C:\Mes documents"
On Error GoTo 0
Monfichier = "C:\Mes documents\" & "Vieux PF "
If Dir(Monfichier & ".xls") <> "" Then
Jour = Day(Now) & "-" & Month(Now) & "-" & Year(Now)
Monfichier = Monfichier & " " & Jour
End If
End If
Monfichier = Monfichier & ".xls"
ThisWorkbook.SaveCopyAs Monfichier
MsgBox "Sauvegarde terminée."
'Sub SendEMailwithAttachments()
Dim NouveauClasseur As Workbook
Dim Destinataire As String
Destinataire = "" 'à adapter
Dim Objetmessage As String
Objetmessage = " VIEUX PF" 'à adapter
Application.ScreenUpdating = False
Set NouveauClasseur = ActiveWorkbook
Dim ol As Object, myItem As Object
Set ol = CreateObject("outlook.application")
Set myItem = ol.CreateItem(olMailItem)
myItem.To = Destinataire
myItem.Subject = Monfichier
myItem.Body = "Bonjour, ceci est un email avec fichier joint" 'à adapter
'fichier en cours d'utilisation envoyé en attaché:
myItem.attachments.Add ActiveWorkbook.FullName
myItem.Send
Set ol = Nothing
Application.DisplayAlerts = False
With NouveauClasseur
.ChangeFileAccess xlReadOnly
Kill .FullName
Application.DisplayAlerts = True
.Close False
End With
End Sub
Dernière édition: