Pb Imprimer Et Enregistrer

**lindette** · 01/08/2007, 16h08

bonjour à tous
Voilà une personne à créer pour mon collaborateur qui est veugle (ne se sert pas du tout de la souris) un programme sous excel pour taper les devis. Quand il afini de taper son devis en faisont crtl+F cela l'imprime automatiquement en regroupant l'entête du devis + grille (qui va de A2 à E2°, cela enléve également les lignes non utilisés et les formules de calcul qui sont EN I1 et J1 et ensuite cela l'enregistre. Mais cela l'enregistre avec les formules qui sont en I1 et J1. Donc si j'ai besoin de le réimprimer cela l'imprime sur 2 feuilles et avec les formules!!! j'aimerais en fait qu'il soit enregistrer comme il est imprimer.
Quelqu'un pourrait-il m'aider, sachant que je suis complétement nulle!!!
merci d'avance
Linda

**LeForestier** · 01/08/2007, 16h43

bonjour,
et ça l'enrégistre où et comment ?

**lindette** · 01/08/2007, 16h53

Cela l'enregistre dans un autre classeur nommé CLIENT
pour le comment et bien je pense que c'est avec un code VBA et c'est automatique.
Je peux envoyer le code si nécessaire...
merci

**LeForestier** · 01/08/2007, 17h01

oui, envoi le code, parcequ'il est possible de n'envoyer que la valeur des affichage cellules. A mon avis c'est là qu'il y à un petit problème

**lindette** · 01/08/2007, 17h05

voila le code à partir CTRL+F (finalisation), c'est à dire impression et enregistrement automatique

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:=2, Collate _
        :=True
Else
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$16:$25"
        .PrintTitleColumns = ""
    End With
    ActiveWindow.SelectedSheets.PrintOut From:=1, to:=2, Copies:=2, 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

**LeForestier** · 02/08/2007, 14h08

j'en déduit que c'est dans ce classeur que tu veux une copie devis..

'récupération du devis finalisé et envoi d'une copie dans le dossier CLIENTS pour archivage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
'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

En copiant toute la feuille ont copie tout, il faudrait intercaler....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sheets("devis").Select
Sheets("devis").Copy
'---------------------- Lignes à ajouer
Range("A1:Z58").select ' le nombre de lignes et colonnes à adapter si nécessaire
selection.copy
Range("A1").select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
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

Etant donné le nombre de classeurs ouvert, et surtout avec les même nom je ne suis pas sur que ce soit celui là
A+

Pb Imprimer Et Enregistrer

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager