XL 2016 Enregistrer une zone dans un PDF

[lecoeurma]

Bonjour à tous.
Je sélectionne une zone et je veux l'enregistrer dans un fichier PDF.
Cela fonctione bien je n'ai que la zone sélectionée dans le fichier, mais sur une page A4 entière blanche sur laquelle figure ma petite zone.

Voici le code utilisé

       If Len(Dir(Carte)) > 0 Then
          If MsgBox("voulez-vous écraser le fichier existant ?", vbYesNo + vbCritical + vbDefaultButton2) = vbNo Then Exit Sub
          End If
          'excel vba imprimer zone d'impression en pdf
        Sheets("Envoi").Select
        With ActiveSheet
            .PageSetup.PrintArea = "$C$24:$I$37"
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Carte, Quality:=xlQualityStandard, _
               IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
        End With

Mon souhait serait de n'avoir que la zone dans mon fichier et non une page A4.
Marcel

 

[Phil69970]

Bonjour @lecoeurma et bienvenu sur XLD

Je te propose ceci (non testé faute de fichier....) et à adapter si besoin.

If Len(Dir(Carte)) > 0 Then
    If MsgBox("voulez-vous écraser le fichier existant ?", vbYesNo + vbCritical + vbDefaultButton2) = vbNo Then Exit Sub
End If
'**** Zone impression + export  PDF
With Worksheets("Envoi") 
    .PageSetup.PrintArea = "$C$24:$I$37"
    .PageSetup.Zoom = 150                   ' Valeur du zoom à adapter si besoin
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Carte, Quality:=xlQualityStandard, OpenAfterPublish:=True
End With
'****

A noter :
Les select sont à proscrire autant que faire se peut dans un code VBA
Pour faire une action dans une feuille quelconque pas besoin d'avoir un select

Merci de ton retour

 

[patricktoulon]

on peut aussi faire les choses bien sans approximation arbitraire et parfaitement ajustée automatiquement
la plage c24:i37 imprimer en pdf ou exporter comme tu veux en pleine page (zoom max possible)
auto orienté zoom auto calculé tout est TOTOMATIC
C'est le même principe que ma source image zommée max dans plage en gardant l'aspect ratio
je pense avoir suffisamment commenté pour que ce soit intelligible a tous

Sub test2()
 'patricktoulon
    Dim Rng As Range
    Dim ws As Worksheet
    Dim hRatio As Double, wRatio As Double, Zoom As Long
    Set ws = Worksheets("Envoi")
    Set Rng = ws.Range("C24:I37")
    
    'coeff marge securité  concernant le zoom
    'car excel même si on enleve tout ne commence par l'impression a zero des bords de feuille
    '+ eventuellement les marge pour les même raison dans les paramètres windows de l'imprimante
    Const margeSecurite As Double = 0.9   ' marge de sécurité 1%
    
    With ws
        'la plage a imprimer
        .PageSetup.PrintArea = Rng.Address
        
        'on fait tout peter les saut de pages
        .ResetAllPageBreaks
        'le premier vpagebreak original est toujours difficile a supprimer (un bug dans excel sans gravité)
        'on le supprime donc
        If .VPageBreaks.Count > 1 Then .VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
        
        ' Supprimer tous les sauts de page horizontaux et verticaux
        Do While .HPageBreaks.Count > 0
            .HPageBreaks.Remove 1
        Loop
        Do While .VPageBreaks.Count > 0
            .VPageBreaks.Remove 1
        Loop
        
        
        With .PageSetup
            
            ' on fait peter les header et footer de page
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            
            ' on fait peter les marges
            .TopMargin = 0
            .BottomMargin = 0
            .LeftMargin = 0
            .RightMargin = 0
            .HeaderMargin = 0
            .FooterMargin = 0
            
            ' Désactiver éléments visuels
            .CenterHorizontally = True
            .CenterVertically = True
            .PrintGridlines = False
            .PrintHeadings = False
            .PrintComments = xlPrintNoComments
            
            
            Dim width_papier As Double, height_papier As Double
            
            'on determine ici le landscape ou protrait et par la même ocasion les largeuret hauteur de papier
            'et les  Dimensions de la feuille papier en points!!!!
            If Rng.Width > Rng.Height Then
                width_papier = Application.CentimetersToPoints(29.7)
                height_papier = Application.CentimetersToPoints(21)
                .Orientation = xlLandscape
            Else
                width_papier = Application.CentimetersToPoints(21)
                height_papier = Application.CentimetersToPoints(29.7)
                .Orientation = xlPortrait
            End If
            
            'on fait les ratios des largeur et hauteur par rapport a la plage a imprimer
            wRatio = width_papier / Rng.Width
            hRatio = height_papier / Rng.Height
            'et on garde l'entier du min des deux
            Zoom = Int(Application.Min(wRatio, hRatio) * 100 * margeSecurite) 'le zoom*le coeff de securité
            
            ' on ne peut pas aller plus loin que 400% en zoom dans excel alors on impose la limite
            If Zoom > 400 Then Zoom = 400
            If Zoom < 10 Then Zoom = 10
            
            .Zoom = Zoom 'on applique le zoom calculer à l'entier près
        End With
        
        ' on ecrase le fichier existant
        If Len(Dir(Carte)) > 0 Then Kill Carte
        
        ' amis du soir  bonsoir c'est dans la boite
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Carte, Quality:=xlQualityStandard, OpenAfterPublish:=True
    End With
    
End Sub

changez sub pour function argument c'est réutilisable à souhait
patrick