Bonjour à tous
j'ai un programme devis avec excel créé spécialement pour mon collaborateur qui est aveugle (qui ne se sert donc pas du tout de la souris)
quand il a fini de taper son devis il fait ctr+F et cela l'imprime automatiquement et l'enregistre, le probléme c'est que cela ne l'enregistre pas comme l'impression. cela l'enregistre avec les formules qui sont dans des colonnes en dehors du devis et moi j'aimerais que cela l'enregistre comme à l'impression? j 'espére que vous comprendrez ce que je veux dire.
voici le code que j'ai:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Merci beaucoup pour votre aide
Linda