Bonjour,

J'ai tapé un code me permettant d'imprimer un pdf d'une plage de ma feuille. Cependant, le pdf ainsi créé imprime bien que la plage souhaitée mais j'ai de grande surface blanche autour. Un peu comme si ma plage était imprimée au milieu d'une feuille A4.
Je ne peux donc pas faire un simple copier/coller du document pdf dans un word par exemple, je doit systématiquement rogner l'image du pdf importer pour n'avoir que la taille de la plage désirée.

Y a-t-il une solution pour que la taille de mon pdf s’arrête précisément à la limite de la plage ?

J'ai essayé de redimensionner la taille de la page, le IgnorePrintAreas ne change rien... Je sèche...

Merci pour votre aide

Frédéric

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
 
Sub CrerImageAvecJPG()
 
    Dim NumPrel, Description, REP As String
    Dim Repertoire As FileDialog
    Dim Ochart As ChartObject
    Dim ZoneImpAvecImg As Range
    Dim Sh_temp As Worksheet
    Dim Ch_temp As Chart
    Dim PicTemp As Picture
 
    NumPrel = Range("NumPrel").Value
    Description = Range("Description").Value
 
    Application.ScreenUpdating = False
    Calculate
    DoEvents
    ActiveWorkbook.Save 'enregistre le classeur
    ActiveSheet.Unprotect Password:="zweco"
 
'contrôles de la saisie complète des données
        X = "YES"
        If Range("Description").Value = "" Then
       X = "NO"
       MsgBox "Vous n'avez pas saisi de description de l'échantillon"
    End If
    If Range("NumPrel").Value = "" Then
       X = "NO"
       MsgBox "Vous n'avez pas saisi le numéro du prélèvement"
    End If
        If Range("Labo").Value = "" Then
       X = "NO"
       MsgBox "Vous n'avez pas saisi la nom du labo"
    End If
 
'Choix du répeertoire où enregistrer le document
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker) 'selection du répertoire
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
    Else
        MsgBox "Aucun Répertoire Sélectionné": ActiveSheet.Protect Password:="zweco", DrawingObjects:=False, Contents:=True, AllowFormattingCells:=True 'protège la feuille
        Exit Sub
    End If
    REP = Repertoire.SelectedItems(1)
    ChDir (REP)
 
'Impression avec image
         Application.ScreenUpdating = False
         Set ZoneImpAvecImg = ActiveSheet.Range("ZoneImpAvecImg")
         Set Sh_temp = Worksheets.Add
         Charts.Add
 
 
         ActiveChart.Location Where:=xlLocationAsObject, Name:=Sh_temp.Name
         Set Ch_temp = ActiveChart
 
        ZoneImpAvecImg.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        Ch_temp.Paste
        Set PicTemp = Selection
        With Ch_temp.Parent
            .Width = 2800
            .Height = 600
        End With
 
      Application.DisplayAlerts = False
 
        ActiveSheet.PageSetup.PrintArea = Range("ZoneImpAvecImg")
     Ch_temp.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Ech n° " & NumPrel & " - " & Description, Quality:= _
        xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
 
        Sh_temp.Delete
        Application.DisplayAlerts = True
 
Fin:
End Sub