Bonjour j'aimerai savoir si c'était possible d'imprimer un tableau qui est à la base en format A4. Et dans un programme dire de la ratraicir format A5 et de donc d'imprimer deux feuille de calcul sur sur la même page....
Est - ce possible??
Version imprimable
Bonjour j'aimerai savoir si c'était possible d'imprimer un tableau qui est à la base en format A4. Et dans un programme dire de la ratraicir format A5 et de donc d'imprimer deux feuille de calcul sur sur la même page....
Est - ce possible??
Regarde à PageSetup, dans l'aide ;)
Edit
Et plus précisément les propriétés
Code:
1
2.Orientation = xlPortrait .PaperSize = xlPaperLegal 'pour le format, c'est là...
Voila mon code mais sa marche pas enfaite, je redit ce que je veux déja j'ai un problème avecCode:
1
2
3
4
5
6
7 b = Workbooks(1).Sheets.Count For j = 14 To b With Worksheets("j") .PageSetup.Orientation = xlLandscape .PaperSize = xlPaperA5 .PrintOut End With
...Ensuite ce que je veux au départ, c'est un zoom arriere qui me permetrai d'imprimez sur un A5 alors que mon tableau rempli une page A4...Une fois que ceci est fait je veut mettre cote à cote deux tableaux : le tableau de la feuille1 et cleui de la feuille2Citation:
With Worksheets("j")
Est-ce vraiment possible...
Enlève les " " ?
merci sa je l'avais trouvez apres l'voir écrit, mais c plutot l'histoire du zoom et de l'impresion
avecCitation:
...Ensuite ce que je veux au départ, c'est un zoom arriere qui me permetrai d'imprimez sur un A5 alors que mon tableau rempli une page A4...Une fois que ceci est fait je veut mettre cote à cote deux tableaux : le tableau de la feuille1 et cleui de la feuille2
Est-ce vraiment possible...
je préfèrerais, à la propriété Zoom les propriétésCitation:
.PaperSize = xlPaperA5
qui te permettent de fixer le nombre de pages en largeur et hauteur sans réduire le format d'édition de tes tableaux.Code:
1
2 .FitToPagesWide = 2 .FitToPagesTall = 1
Tu vois
Il me dit que j'ai une erreur sur l'objet bizarre sa doit être encore ma syntaxe qui n'est pas bonne...rrrrCode:
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 Private Sub CommandButton2_Click() Dim i As Integer Dim b As Integer Dim j As Integer Dim fichier As Single Dim impression As String Dim bilan As String For i = 15 To 25 impression = Cells(i, 1).Value fichier = Workbooks(1).Sheets(14).Cells(i, 6).Value If fichier <> "0" Then For Each LaFeuille In ActiveWorkbook.Worksheets If LCase(impression) = LCase(LaFeuille.Name) Then With Worksheets(impression) .PageSetup.Orientation = xlLandscape .FitToPagesWide = 2 .FitToPagesTall = 1 .PrintOut End With Exit For End If Next End If Next i b = Workbooks(1).Sheets.Count For j = 14 To b With Worksheets(j) .PageSetup.Orientation = xlLandscape .FitToPagesWide = 2 .FitToPagesTall = 1 .PrintOut End With Next j End Sub
Un conseil : Pour avoir la syntaxe du Setup qui te convient, enregistre une macro en faisant ta mise en page avec "aperçu avant impression, dans Excel.
Une fois ton code d'aplomb, tu nous le montres qu'on supprime le code inutile ;)
Bref, là je ne vois pas mais déjà, je ne comprends pas cette ligne
With Worksheets(j)
Teste déjà çaCode:
1
2
3
4
5
6
7
8
9
10
11
12
13 If fichier <> "0" Then For Each LaFeuille In ActiveWorkbook.Worksheets If LCase(impression) = LCase(LaFeuille.Name) Then With LaFeuille .PageSetup.Orientation = xlLandscape .FitToPagesWide = 2 .FitToPagesTall = 1 .PrintOut End With Exit For End If Next End If
Tu dis
A+
C'est bien impression qui faut mettre il me dit que c'est la syntaxe de saCode:
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 Private Sub CommandButton2_Click() Dim i As Integer Dim b As Integer Dim j As Integer Dim fichier As Single Dim impression As String Dim bilan As String For i = 15 To 25 impression = Cells(i, 1).Value fichier = Workbooks(1).Sheets(14).Cells(i, 6).Value If fichier <> "0" Then For Each LaFeuille In ActiveWorkbook.Worksheets If LCase(impression) = LCase(LaFeuille.Name) Then With worksheets(impression) .PageSetup.Orientation = xlLandscape .FitToPagesWide = 2 .FitToPagesTall = 1 .PrintOut End With Exit For End If Next End If Next i b = Workbooks(1).Sheets.Count For j = 14 To b With Worksheets(j) .PageSetup.Orientation = xlLandscape .FitToPagesWide = 2 .FitToPagesTall = 1 .PrintOut End With Next j End Sub
Citation:
With Worksheets(j)
.PageSetup.Orientation = xlLandscape
.FitToPagesWide = 2
.FitToPagesTall = 1
.PrintOut
End With
En aynt fait des test manuellement, cela ne marche pas car oui il ratrécit bien mes tableaux mais ne fait pas se que je veux...SUr ma feuille de calcul 1 j'ai une page, sur ma feuille de calcul 2 idem...DOnc je veux que les deux soit rassemblez à l'impression...
Alors tu as la solution de la copie de plage
Consiste à copier séparément tes deux plages (l'entête aura disparu :( ) et à les coller dans un document Word et à imprimer l'ensemble en mode paysage.
Je ferais ça dans Word (Je parle du collage et de l'édition des deux images) car la gestion des marges et de la mise en page serait plus aisée.
En outre, si tu les colles dans un tableau de deux cellules, tu peux ajouter un en-tête pour chacune des deux pages.
Tu peux aussi essayer la propriété zoom dans le setup mais je ne sais pas ce que ça donne.
C'est toi qui vois.
A+
J'ai rien compris et je sais pas programmez dans word...Je c'est maintenant mieux me débrouiller dans excel grace a vos solutions et vos astuce je vous en remercie...Mais la la copie de plage je n'y arriverai jamais
Tu veux rire ! Regarde là, c'est "presque" tout fait ;)
A+
Voila j'ai fait mon code, j'espère que vous le comprendrez car il ne marche pas il me dit déja dès la deuxieme ligne il me met l'erreur : type définit par l'utilisateur non définieCode:
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 Private Sub CommandButton1_Click() Dim WdApp As Word.Application Dim WdDoc As Word.Document Dim i, hauteur As Double, plage As Range Dim j As Integer Dim nbre As Integer Set WdApp = CreateObject("word.application") Set WdDoc = WdApp.Documents.Open("C:\ah.doc") WdApp.Visible = True nbre = ActiveWorkbook.Sheets.Count For j = 2 To 11 If Worksheets(j).Range(J25) <> 0 Or Worksheets(j).Range(J26) <> 0 Then Do 'Sélection de la plage de cellules à copier On Error Resume Next 'gère une plage nulle Set plage = Range("A1:L38") If plage Is Nothing Then GoTo Fin 'sortie si plage vide On Error GoTo 0 Loop While InStr(plage.Address, ",") <> 0 plage.Copy 'plage copiée DoEvents 'laisse au system le temps de copier la plage 'Place l'image sur le signet "Signet" With WdApp .Selection.Goto What:=wdGoToBookmark, Name:="Signet" .Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, _ Placement:=wdInLine, DisplayAsIcon:=False WdDoc.InlineShapes(1).Width = 132 'Règle la largeur dans Word 'Calcul de la hauteur de plage dans le document word hauteur = 132 / WdDoc.InlineShapes(1).Width _ * WdDoc.InlineShapes(1).Height WdDoc.InlineShapes(1).Height = Int(hauteur) 'Règle la hauteur End With Next j If nbre > 15 Then For j = 16 To nbre If Worksheets(j).Range(J25) <> 0 Or Worksheets(j).Range(J26) <> 0 Then Do 'Sélection de la plage de cellules à copier On Error Resume Next 'gère une plage nulle Set plage = Range("A1:L38") If plage Is Nothing Then GoTo Fin 'sortie si plage vide On Error GoTo 0 Loop While InStr(plage.Address, ",") <> 0 plage.Copy 'plage copiée DoEvents 'laisse au system le temps de copier la plage 'Place l'image sur le signet "Signet" With WdApp .Selection.Goto What:=wdGoToBookmark, Name:="Signet" .Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, _ Placement:=wdInLine, DisplayAsIcon:=False WdDoc.InlineShapes(1).Width = 132 'Règle la largeur dans Word 'Calcul de la hauteur de plage dans le document word hauteur = 132 / WdDoc.InlineShapes(1).Width _ * WdDoc.InlineShapes(1).Height WdDoc.InlineShapes(1).Height = Int(hauteur) 'Règle la hauteur End With Next j End If 'WdApp.Visible = True 'Pour voir (Ne pas fermer le fichier depuis Word) Fin:: WdDoc.Close True 'Enregistre et ferme le doc word DoEvents 'Laisse au system le temps d'enregistrer le fichier WdApp.Quit 'ferme la session Set plage = Nothing Set WdApp = Nothing Set WdDoc = Nothing End Sub
Oui :( J'ai oublié de mentionner en entête qu'il est nécessaire de valider la référence Microsoft Word x.xx Object library. Pour ça, c'est simple, dans l'éditeur VBA, Outils -> Référence -> Tu valides
Désolé mais je n'avais pas corrigé car ilcocodrillo l'avait signalé ;)
A+
Maintenant il disent que dans ma premiere boucle for, que mon next n'a pas de for moi rine comprendre desfois à windows...Et pour reference et tout , il faut activer sur le pc a chaque fois que l'on bossera sur ce programmeCode:
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 Private Sub CommandButton1_Click() Dim WdApp As Word.Application Dim WdDoc As Word.Document Dim i, hauteur As Double, plage As Range Dim j As Integer Dim k As Integer Dim nbre As Integer Set WdApp = CreateObject("word.application") Set WdDoc = WdApp.Documents.Open("C:\ah.doc") WdApp.Visible = True nbre = ActiveWorkbook.Sheets.Count For j = 2 To 11 If Worksheets(j).Range(J25) <> 0 Or Worksheets(j).Range(J26) <> 0 Then Do 'Sélection de la plage de cellules à copier On Error Resume Next 'gère une plage nulle Set plage = Range("A1:L38") If plage Is Nothing Then GoTo Fin 'sortie si plage vide On Error GoTo 0 Loop While InStr(plage.Address, ",") <> 0 plage.Copy 'plage copiée DoEvents 'laisse au system le temps de copier la plage 'Place l'image sur le signet "Signet" With WdApp .Selection.Goto What:=wdGoToBookmark, Name:="Signet" .Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, _ Placement:=wdInLine, DisplayAsIcon:=False WdDoc.InlineShapes(1).Width = 132 'Règle la largeur dans Word 'Calcul de la hauteur de plage dans le document word hauteur = 132 / WdDoc.InlineShapes(1).Width _ * WdDoc.InlineShapes(1).Height WdDoc.InlineShapes(1).Height = Int(hauteur) 'Règle la hauteur End With Next j If nbre > 15 Then For k = 16 To nbre If Worksheets(k).Range(J25) <> 0 Or Worksheets(k).Range(J26) <> 0 Then Do 'Sélection de la plage de cellules à copier On Error Resume Next 'gère une plage nulle Set plage = Range("A1:L38") If plage Is Nothing Then GoTo Fin 'sortie si plage vide On Error GoTo 0 Loop While InStr(plage.Address, ",") <> 0 plage.Copy 'plage copiée DoEvents 'laisse au system le temps de copier la plage 'Place l'image sur le signet "Signet" With WdApp .Selection.Goto What:=wdGoToBookmark, Name:="Signet" .Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, _ Placement:=wdInLine, DisplayAsIcon:=False WdDoc.InlineShapes(1).Width = 132 'Règle la largeur dans Word 'Calcul de la hauteur de plage dans le document word hauteur = 132 / WdDoc.InlineShapes(1).Width _ * WdDoc.InlineShapes(1).Height WdDoc.InlineShapes(1).Height = Int(hauteur) 'Règle la hauteur End With Next k End If 'WdApp.Visible = True 'Pour voir (Ne pas fermer le fichier depuis Word) Fin:: WdDoc.Close True 'Enregistre et ferme le doc word DoEvents 'Laisse au system le temps d'enregistrer le fichier WdApp.Quit 'ferme la session Set plage = Nothing Set WdApp = Nothing Set WdDoc = Nothing End Sub
Moi rien comprendre, il dit que ma boucle ne va pas, mais boucle pose un problème...
Si tu rangeais correctement tes affaires, tu te serais aperçu qu'il manquait TROIS Endif, pas un, TROIS
Je n'ai pas regardé ce que fait ton code, je t'en laisse le soin :evil:Code:
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 Private Sub CommandButton1_Click() Dim WdApp As Word.Application Dim WdDoc As Word.Document Dim i, hauteur As Double, plage As Range Dim j As Integer Dim k As Integer Dim nbre As Integer Set WdApp = CreateObject("word.application") Set WdDoc = WdApp.Documents.Open("C:\ah.doc") WdApp.Visible = True nbre = ActiveWorkbook.Sheets.Count For j = 2 To 11 If Worksheets(j).Range(J25) <> 0 Or Worksheets(j).Range(J26) <> 0 Then Do 'Sélection de la plage de cellules à copier On Error Resume Next 'gère une plage nulle Set plage = Range("A1:L38") If plage Is Nothing Then GoTo Fin 'sortie si plage vide On Error GoTo 0 Loop While InStr(plage.Address, ",") <> 0 plage.Copy 'plage copiée DoEvents 'laisse au system le temps de copier la plage 'Place l'image sur le signet "Signet" With WdApp .Selection.Goto What:=wdGoToBookmark, Name:="Signet" .Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, _ Placement:=wdInLine, DisplayAsIcon:=False WdDoc.InlineShapes(1).Width = 132 'Règle la largeur dans Word 'Calcul de la hauteur de plage dans le document word hauteur = 132 / WdDoc.InlineShapes(1).Width _ * WdDoc.InlineShapes(1).Height WdDoc.InlineShapes(1).Height = Int(hauteur) 'Règle la hauteur End With End If Next j If nbre > 15 Then For k = 16 To nbre If Worksheets(k).Range(J25) <> 0 Or Worksheets(k).Range(J26) <> 0 Then Do 'Sélection de la plage de cellules à copier On Error Resume Next 'gère une plage nulle Set plage = Range("A1:L38") If plage Is Nothing Then GoTo Fin 'sortie si plage vide On Error GoTo 0 Loop While InStr(plage.Address, ",") <> 0 plage.Copy 'plage copiée DoEvents 'laisse au system le temps de copier la plage 'Place l'image sur le signet "Signet" With WdApp .Selection.Goto What:=wdGoToBookmark, Name:="Signet" .Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, _ Placement:=wdInLine, DisplayAsIcon:=False WdDoc.InlineShapes(1).Width = 132 'Règle la largeur dans Word 'Calcul de la hauteur de plage dans le document word hauteur = 132 / WdDoc.InlineShapes(1).Width _ * WdDoc.InlineShapes(1).Height WdDoc.InlineShapes(1).Height = Int(hauteur) 'Règle la hauteur End With End If Next k End If 'WdApp.Visible = True 'Pour voir (Ne pas fermer le fichier depuis Word) Fin:: WdDoc.Close True 'Enregistre et ferme le doc word DoEvents 'Laisse au system le temps d'enregistrer le fichier WdApp.Quit 'ferme la session Set plage = Nothing Set WdApp = Nothing Set WdDoc = Nothing End Sub