'--------------------------------------------------
Private Sub fin_Click()
'--------------------------------------------------
Unload UserForm1
ThisWorkbook.Save
'archive
total
copie
'Sheets("construction_devis").Select
'Sheets("construction_devis").Activate
'Sheets("construction_devis").Copy
'Sheets("devis_imprimable").Activate
'Sheets("Devis_details").Select
'Application.Quit
Dim derLig As Long
Dim Lig As Long
Dim LigTab As Long
Dim forfait As Boolean
Sheets("devis_imprimable").Activate
' Effacer les cellules résultat
derLig = Range("H" & Cells.Rows.Count).End(xlUp).Row
If derLig < 8 Then derLig = 8
Range("H8:L" & derLig).Clear
' Dernière ligne en colonne B
derLig = Range("B" & Cells.Rows.Count).End(xlUp).Row + 1
' Vérifier qu'il existe une ligne de fin de forfait
If Application.WorksheetFunction.CountIf(Range("C8:C" & derLig), "___ Fin forfait ___") = 0 Then Exit Sub
Application.ScreenUpdating = False
' Première ligne de transfert
LigTab = 8
forfait = False
' Boucle de la ligne 8 à la dernière
For Lig = 8 To derLig
' Début du forfait - Transférer la ligne dans le tableau résultat
If UCase(Range("C" & Lig).Value) Like "FORFAIT*" Then
Range("B" & Lig & ":F" & Lig).Copy Destination:=Range("H" & LigTab)
Application.CutCopyMode = False
forfait = True
Else
' Forfait détecté dans une ligne précédente
If forfait = True Then
' Si fin du forfait, annuler le forfait et incrémenter la ligne
If Range("C" & Lig).Value = "___ Fin forfait ___" Then
forfait = False
LigTab = LigTab + 1
' Ajouter les valeurs à la ligne de forfait
Else
Range("D" & Lig & ":F" & Lig).Copy
Range("J" & LigTab).PasteSpecial _
Paste:=xlPasteAll, Operation:=xlAdd, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
' Ligne normale à transférer dans le tableau résultat
Else
Range("B" & Lig & ":F" & Lig).Copy Destination:=Range("H" & LigTab)
Application.CutCopyMode = False
LigTab = LigTab + 1
End If
End If
Next Lig
' Dernière ligne en colonne B
derLig = Range("C" & Cells.Rows.Count).End(xlUp).Row + 1
If derLig < 8 Then derLig = 8
' Effacer le premier tableau
Range("B8:F" & derLig).Clear
' Dernière ligne en colonne H
derLig = Range("I" & Cells.Rows.Count).End(xlUp).Row + 1
If derLig < 8 Then derLig = 8
'Déplacer le 2me tableau à la place du premier
Range("H8:L" & derLig).Cut Destination:=Range("B8")
Application.CutCopyMode = False
' Formater le tableau en fonte Arial 8 et colonne B centrée
With Range("B7:F" & derLig)
.Font.Name = "Arial"
.Font.Size = 8
End With
Range("B7:B" & derLig).HorizontalAlignment = xlCenter
Range("A8").Select
Application.ScreenUpdating = True
End Sub
'--------------------------------------------------
Private Sub forfait_Click()
'--------------------------------------------------
If forfait.Caption = "Débuter un forfait" Then
forfait_use.Show
Else
Ligne = Devis.numeroDerniereLigne + 1
'envoi des informations de l'Useform => les cellules
Set sheetDevis = Sheets("construction_devis")
sheetDevis.Cells(Ligne, 1).Value = "_"
sheetDevis.Cells(Ligne, 2).Value = "___ Fin forfait ___"
sheetDevis.Cells(Ligne, 3).Value = "000"
For i = 1 To 24
sheetDevis.Cells(Ligne, i).Font.Bold = False
sheetDevis.Cells(Ligne, i).Font.Size = 9
Next i
forfait.Caption = "Débuter un forfait"
End If
End Sub