Discussion :

[sormick]

Bonjour,
J'ai inséré une Image JPG sur Excel et je souhaiterais via VBA l'imprimer en format et dimension A4 mais malheureusement je ne sais pas comment faire car la fonction printout ne fonctionne pas sur cette macro et lorsque j'y arrive avec d'autres macros l'image n'est pas bien redimensionnée en Format A4.
Voici ce que j'ai:

Code :

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

1
2
3
4
5
6
Dim Img As Object
 Sheets("feuil1").Select
  For Each Img In Worksheets("feuil1").Shapes
  Img.Select
  Next
selection.printout

[kiki29]

Salut, te renseigner sur CentimetersToPoints
puis via qqch comme

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
.....
Coeff = 29.7 / 21
W = Application.CentimetersToPoints(29.7)
H = W * Coeff
 
With ActiveSheet.Shapes(Tablo(i))
    .Left = L
    .Top = T
    .Width = W
    .Height = H
End With
 
.....

où Tablo est rempli via ceci

Code :

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

1
2
3
4
5
6
7
Erase Tablo
For Each oOle In Worksheets(ActiveSheet.Name).OLEObjects
    sNomOle = ActiveSheet.Shapes(oOle.Name).Name
    ReDim Preserve Tablo(i)
    Tablo(i) = sNomOle
    i = i + 1
Next oOle

Un A4 imprimé à 300 dpi fait au départ 2480 x 3508 pixels

[sormick]

Merci beaucoup !
Excellente journée a vous tous !

[patricktoulon]

Code :

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

1
2
3
sub test()
ImprimeGrandFormat sheest(X),Shapes(Y)
end sub

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
Sub ImprimeGrandFormat(Wsh As Worksheet, Shp As Shape)
    Dim w
    With Wsh
        With .PageSetup
            .TopMargin = 0
            .LeftMargin = 0
            .RightMargin = 0
            .BottomMargin = 0
            .FooterMargin = 0
            .HeaderMargin = 0
            .CenterHorizontally = True
            .CenterVertically = True
            .Orientation = IIf(Shp.Width > Shp.Height, 2, 1)
        End With
        With Shp
             t=.top :l=.left: w = .Width
            If .Width < .Height Then
                .Height = Application.CentimetersToPoints(29.7)
            Else
                .Width = Application.CentimetersToPoints(21)
            End If
            .Top = 0
            .Left = 0
        End With
        With .PageSetup
            If Shp.Width < Shp.Height Then
                .FitToPagesTall = 1
                '.FitToPagesWide = 1
            Else
                '.FitToPagesTall = 1
                .FitToPagesWide = 1
            End If
        End With
    End With
    Wsh.PrintPreview
    Shp.Width = w:shp.left=l:shp.top=t
End Sub