1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
| Sub finalisation()
' récupération de l'entête et collage sur la feuille devis
Rows("1:24").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
Sheets("entetedevis").Select
Range("A1:H23").Select
Range("H23").Activate
Selection.Copy
Sheets("devis").Select
ActiveSheet.Paste
Range("D10").Select
Columns("A:A").Select
Selection.EntireColumn.Hidden = True
'transfert des données devis vers l'historique, enregistrement de l'historique et fermeture,
'retour sur devis
Workbooks.Open Filename:= _
"C:\Documents and Settings\owner\Mes documents\Historique_devis.xls"
'Workbooks.Open Filename:= _
"C:\Documents and Settings\Thierry\Mes documents\Perso\ALU\Historique_devis.xls"
Windows("Etablir_devis.xls").Activate
Range("E11").Select
Selection.Copy
Windows("Historique_devis.xls").Activate
If Range("A2").Value = "" Then
decalage2 = 0
Range("A2").Select
Else
Position = Range("A1").End(xlDown).Address
Range(Position).Select
Range("A1").End(xlDown).Select
decalage2 = 1
End If
ActiveCell.Offset(decalage2, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Etablir_devis.xls").Activate
Range("E14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Historique_devis.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
Windows("Etablir_devis.xls").Activate
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Historique_devis.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
Windows("Etablir_devis.xls").Activate
ActiveWindow.SmallScroll Down:=60
Range("E87").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Historique_devis.xls").Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWindow.SmallScroll Down:=-69
Range("E1").Select
'suppression des lignes vides devis en vue de l'impression.
nbtot = 58
Range("B26").Select
For compteur = 1 To nbtot
If ActiveCell.Value = "" Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Next compteur
'
' impression
' enregistrée le 26/04/2007 par Thierry Dauchez
MsgBox ("Etes-vous prêt à imprimer ? ... L'imprimante est-elle allumée, y a t'il du papier suffisamment ? (Cliquez sur OK, une fois prêt)")
Range("A25").Select
Set plage = Range("A25", [A25].End(xlDown))
nbcell = plage.Count + 3
If nbcell <= 32 Then
ActiveWindow.SelectedSheets.PrintOut From:=1, to:=1, Copies:=1, Collate _
:=True
Else
With ActiveSheet.PageSetup
.PrintTitleRows = "$16:$25"
.PrintTitleColumns = ""
End With
ActiveWindow.SelectedSheets.PrintOut From:=1, to:=2, Copies:=1, Collate _
:=True
End If
'récupération du devis finalisé et envoi d'une copie dans le dossier CLIENTS pour archivage
Sheets("entetedevis").Select
MsgBox ("Pour conclure : Création d'un duplicata du devis dans un classeur à part nommé " & Range("H1").Value & " afin d'en conserver une trace. Validez pour poursuivre, merci.")
Sheets("devis").Select
Sheets("devis").Copy
ChDir "C:\Documents and Settings\owner\Mes documents\CLIENTS"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\owner\Mes documents\CLIENTS\" & Range("H1").Value & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'Sheets("devis").Select
'Sheets("devis").Copy
'ChDir "C:\Documents and Settings\Thierry\Mes documents\Perso\ALU\CLIENTS"
'ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\Thierry\Mes documents\Perso\ALU\CLIENTS\" & Range("H1").Value & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Windows("Etablir_devis.xls").Activate
Sheets("devis").Select
Selection.EntireColumn.Hidden = False
Range("A26:A84").Select
Selection.ClearContents
Range("C26:C84").Select
Selection.ClearContents
Range("D26:D84").Select
Selection.ClearContents
Range("B26").Select
Sheets("Accueil").Select
Application.DisplayAlerts = False
ActiveWindow.Close
End Sub |
Partager