top of page

 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





 

bottom of page