Microsoft 365 Outils de planification

Private Sub Tbx_Change()
    If Tbx.Tag = 7 Then
        Tbx.BackColor = Tu(1, Tbx.Tag)
        Tbx.ForeColor = Tu(1, Tbx.Tag)
    End If
    Tu(1, Tbx.Tag) = Tbx.Value
End Sub

Sub export_excel()

Dim liste As Range, wb As Workbook, w As Worksheet, Roc As Range, Cor As Range, derlig&, Chemin$, nom1$, pa As Range, n%, nom2$
Application.ScreenUpdating = False          ''''''''''''''''''''''déplacé
     
                                ''''''''''''''''''''''ajouté
Feuil3.Activate

Set liste = [F3].CurrentRegion 'à adapter
If Application.CountBlank(liste.Columns(2)) = 0 Then MsgBox "Toutes les feuilles sont exclues !": Exit Sub
'---copie dans un document auxiliaire---
Application.ScreenUpdating = False
Set wb = Workbooks.Add(xlWBATWorksheet)
For Each w In ThisWorkbook.Worksheets

        w.Copy After:=wb.Sheets(wb.Sheets.Count)
        wb.Sheets(wb.Sheets.Count).UsedRange = w.UsedRange.Value 'supprime les formules
        wb.Sheets(wb.Sheets.Count).Name = w.Name
       
   


Next
'---création des fichiers Excel---
Chemin = ThisWorkbook.Path & "\" 'à adapter
Application.DisplayAlerts = False
wb.Sheets(1).Delete
nom1 = "Planning " & Format(Now, "yyyy-mm-dd hhmmss")
wb.SaveAs Chemin & nom1
Set w = wb.Sheets(1)
Set pa = w.UsedRange
For n = 2 To wb.Sheets.Count
    With w.Rows(w.UsedRange.Row + w.UsedRange.Rows.Count + 1) 'décalage d'une ligne
        wb.Sheets(n).UsedRange.EntireRow.Copy .Cells
        Set pa = Union(pa, Intersect(w.UsedRange, .Resize(w.Rows.Count - .Row + 1)))
    End With
Next
w.PageSetup.Zoom = False
w.PageSetup.FitToPagesWide = 1 'une page en largeur
w.PageSetup.PrintArea = pa.Address 'zone d'impression multiple

wb.Close False 'fermeture du fichier Excel
Application.ScreenUpdating = True
MsgBox "Fichiers '" & nom1 & "'  créés..."
                                                    ''''''''''''''''''''''ajouté
   
Application.ScreenUpdating = True                   ''''''''''''''''''''''ajouté
End Sub