Sub Decoupage_File()
' Don't show confirmation window
Application.DisplayAlerts = False
'En amont
'Check STEPS end
Sheets("PilotageCtrlAuto").Range("E1").Value = "" 'effacer données
Sheets("PilotageCtrlAuto").Range("E2").Value = "" 'effacer données
Sheets("PilotageCtrlAuto").Range("E3").Value = "" 'effacer données
Sheets("PilotageCtrlAuto").Select
Range("E1") = Now
'Macro
Dim Path_Files_Attached As String
' Path_Files_Attached = "P:\Recertification\"
Path_Files_Attached = "\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\2020\Task #6 - Recertification campaign\01 - Préparation\Baptiste\_Conso\"
'FichierControle = Active.Worbook
FichierControle = ActiveWorkbook.Name
Sheets("PilotageCtrlAuto").Activate
Range("A1").Select
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To DernLigne
'MyCurrentFileName = ActiveCell.Value
MyCurrentFileName = Cells(i, 1).Value
'Désactivation du filtre auto
If Sheets("Conso Fin").AutoFilterMode Then
Sheets("Conso Fin").AutoFilterMode = False
End If
'Filtre avec la colonne K de Sheets("Conso Fin")
Sheets("Conso Fin").Range("A1").AutoFilter Field:=13, Criteria1:=MyCurrentFileName, Operator:=xlFilterValues
' créer le fichier + sauvegarde du fichier
'Path_Files_Attached = "P:\Recertification\"
'Path_Files_Attached = Sheets("PilotageCtrlAuto").Range("K1").Value 'Path_Files_Attached
'NomDuFichier = Path_Files_Attached & ControlDate & " - " & MyCurrentFileName & " - " & NbreDroits - 1 & ".xlsx" ' mettre dans une variable le chemin du fichier afin que la personne mette ce quil veut"
Workbooks.Add 1 'Filename:=NomDuFichier
'Workbooks.Add.SaveAs Filename:=NomDuFichier
FileName_i = ActiveWorkbook.Name
' Copier Onglet:
Workbooks(FichierControle).Sheets("Conso Fin").Copy After:=Workbooks(FileName_i).Sheets("Feuil1")
Sheets("Conso Fin").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Coller data
Sheets("Feuil1").Select
ActiveSheet.Paste
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
':=False, Transpose:=False
'Application.CutCopyMode = False
Range("A1").Select
' Suppression de colonne
Columns("J:M").Delete
'Traitement des entêtes
Columns("A:A").ColumnWidth = 12
Columns("B:B").ColumnWidth = 39
Columns("C:C").ColumnWidth = 39
Columns("D:D").ColumnWidth = 39
Columns("E:E").ColumnWidth = 19
Columns("F:F").ColumnWidth = 38
Columns("G:G").ColumnWidth = 38
Columns("H:H").ColumnWidth = 6
Columns("I:I").ColumnWidth = 19
'Traitement de la première ligne du fichier
Rows("1:1").RowHeight = 32
'Cosmétiques largeur de colonnes
Columns("D:D").EntireColumn.AutoFit
Sheets("Feuil1").Activate
Range("A1").Select
ActiveSheet.Name = "ISS"
'Récupération de la date de la journée contrôlée
'Sheet_Name_Date = Format(Now, "yyyy-MM-dd")
'On renomme la feuille?
'ActiveSheet.Name = Sheet_Name_Date
'Suppression du premier onglet
Sheets(2).Delete
'On réduit la taille à 95%
ActiveWindow.Zoom = 95
' créer le fichier + sauvegarde du fichier
'Récupération de la date de la journée contrôlée
'ControlDate = Format(Now, "yyyy")
'Path_Files_Attached = "P:\Recertification\"
'Path_Files_Attached = Sheets("PilotageCtrlAuto").Range("K1").Value 'Path_Files_Attached
NomDuFichier = Path_Files_Attached & MyCurrentFileName & ".xlsx" ' mettre dans une variable le chemin du fichier afin que la personne mette ce quil veut"
'Workbooks.Add 'Filename:=NomDuFichier
'Workbooks.Add.SaveAs Filename:=NomDuFichier
'Save the current workbook
ActiveWorkbook.SaveAs Filename:=NomDuFichier
'Time to save
'ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
ActiveWorkbook.Close
Next i
'Fin du traitement... retour sur le fichier de recertification :
Sheets("Conso Fin").Select
Range("A1").Select
'Désactivation du filtre auto
If Sheets("Conso Fin").AutoFilterMode Then
Sheets("Conso Fin").AutoFilterMode = False
End If
'End
Sheets("PilotageCtrlAuto").Select
Range("E2") = Now
Range("D3") = "Elapsed time (Min) : "
Range("E3") = DateDiff("n", Range("E1"), Range("E2"))
'Mise à jour de l'affichage
Application.ScreenUpdating = True
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
Application.Quit ' Quit Excel
End Sub
'####### STEP 0
Sub SendEmail_Recertification_Campaign()
'Creates a new email item and modifies its properties
Dim objMail As Outlook.MailItem
Dim Ligne As Integer
Dim DernLigne As Integer
Dim Path_EmailTemplate As String
Dim Name_TemplateEmail As String
'Mise à jour de l'affichage
Application.ScreenUpdating = False
'Déclaration des valeurs
Path_EmailTemplate = Sheets("PilotageCtrlAuto").Range("K5").Value 'Path_EmailTemplate
Name_TemplateEmail_FR = Sheets("PilotageCtrlAuto").Range("K6").Value 'Name_TemplateEmail FR
Name_TemplateEmail_EN = Sheets("PilotageCtrlAuto").Range("K7").Value 'Name_TemplateEmail EN
Path_PJ = Sheets("PilotageCtrlAuto").Range("K3").Value 'Path_ Fichiers Découpés
Path_PJ1 = Sheets("PilotageCtrlAuto").Range("K4").Value 'Path_ Fichier PJ1
Path_File_oft = Sheets("PilotageCtrlAuto").Range("K9").Value 'File .oft
'Initialisation data :
Sheets("PilotageCtrlAuto").Range("D1").Value = ""
Sheets("PilotageCtrlAuto").Range("D2").Value = ""
Sheets("PilotageCtrlAuto").Range("D3").Value = ""
Sheets("PilotageCtrlAuto").Range("D6").Value = ""
Sheets("PilotageCtrlAuto").Select
'Set Date ouverture de fichier
Range("C1") = "Last Opened file @ "
Range("D1") = Now
'Check STEPS
Sheets("Mailing").Select
Range("A1").Select
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
'Create email item
For Ligne = 2 To DernLigne
'Set objMail = Outlook.CreateItemFromTemplate("\\smb11-nas1.par.emea.cib\UT2XJJ\HomeDir17\Test\FichierCut\EmailTemplate.msg")
'Set objMail = Outlook.CreateItemFromTemplate("\\smb15-nas1.par.emea.cib\ISS_DATA\05 - Controls\I3C\Remote access\01 - Non Business hours\Setting\EmailTemplate.msg")
If Cells(Ligne, 14) = "FR" Then
Set objMail = Outlook.CreateItemFromTemplate(Path_EmailTemplate & Name_TemplateEmail_FR)
With objMail
'.Attachments.Add "\Script-Génération-mails.vbs"
'Set body format to HTML
.BodyFormat = olFormatHTML
.SentOnBehalfOfName = Range("A" & Ligne) '.SentOnBehalfOfName = "isec-iss-controls@ca-cib.com"
.To = Range("B" & Ligne)
.CC = Range("C" & Ligne)
.BCC = Range("P" & Ligne)
.Subject = Range("D" & Ligne)
source_file = Path_PJ & Range("E" & Ligne)
source_file1 = Path_PJ1 & Range("F" & Ligne)
.Attachments.Add source_file
.Attachments.Add source_file1
.Send '.Display
'.Body = "Daily control starts automaticaly for MOVIS PULSE EMEA 3AM. Source File (xlxs) from Emails on SharedInbox 'ISEC-ISS' will be stored into folder 'SourceFileAM'"
End With
End If
If Cells(Ligne, 14) = "EN" Then
Set objMail = Outlook.CreateItemFromTemplate(Path_EmailTemplate & Name_TemplateEmail_EN)
With objMail
'.Attachments.Add "\Script-Génération-mails.vbs"
'Set body format to HTML
.BodyFormat = olFormatHTML
.SentOnBehalfOfName = Range("A" & Ligne)
.To = Range("B" & Ligne)
.CC = Range("C" & Ligne)
.BCC = Range("P" & Ligne)
.Subject = Range("D" & Ligne)
source_file = Path_PJ & Range("E" & Ligne)
source_file1 = Path_PJ1 & Range("F" & Ligne)
.Attachments.Add source_file
.Attachments.Add source_file1
.Send '.Display
'.Body = "Daily control starts automaticaly for MOVIS PULSE EMEA 3AM. Source File (xlxs) from Emails on SharedInbox 'ISEC-ISS' will be stored into folder 'SourceFileAM'"
End With
End If
Next Ligne
'Set Date Enregistrement du fichier
Sheets("PilotageCtrlAuto").Activate
Range("C2") = "Last time file saved @ "
Range("D2") = Now
Range("C3") = "Temps de Traitement (Min) : "
Range("D3") = DateDiff("n", Range("D1"), Range("D2"))
'Nbr Emails Sent
Sheets("PilotageCtrlAuto").Range("C6").Value = "Status :"
Sheets("PilotageCtrlAuto").Range("D6").Value = DernLigne - 1 & " emails have been sent @ " & Format(Now, "yyyy-mm-dd hh:mm:ss")
'Mise à jour de l'affichage
Application.ScreenUpdating = True
ActiveWorkbook.Save ' Save the current workbook, bypassing the prompt
Application.Quit ' Quit Excel
End Sub