Zone d'impression jusqu'à la dernière ligne de donnée calcul

Résolu
Emi80110 Messages postés 68 Date d'inscription   Statut Membre Dernière intervention   -  
Emi80110 Messages postés 68 Date d'inscription   Statut Membre Dernière intervention   -

Bonjour,

Je cherche une macro me permettant de définir automatiquement ma zone d'impression (des colonnes A a E) jusqu'à la dernière ligne de données calculée, sur une seule page en largeur et en automatique en longueur.

Dans le fichier ci-dessous, J'ai des formules jusqu'à la ligne 404, qui me fourni ou non, un résultat selon les données renseignées dans l'onglet "brouillon". Je n'ai donc pas besoin d'imprimer jusqu'à la ligne 404, mais jusqu'à la dernière ligné alimentée, soit la ligne 189.

https://wetransfer.com/downloads/f9e4f6ab64ca96a1d6ca00368d92178b20250623124954/b4135689aa81d49d054e5ec211311d8420250623125017/9fc678?t_exp=1750942194&t_lsid=a25cb298-8fa8-45c8-85c4-3a099d3b3068&t_network=email&t_rid=ZW1haWx8NjdiZGRhNjgwMmI0Mzc4ZjAwN2ZlOGQ4&t_s=download_link&t_ts=1750683017

(je suis désolée c'est un we transfer. Impossible d'utiliser cjoint qui ne me propose plus que des modes d'emploi en page d'accueil. Impossible de générer le lien avec)

Ce fichier joint n'est qu'un échantillon. Le vrai fichier peut aller jusqu'à 40 000 lignes.

Pouvez-vous m'aider svp ?

Par avance merci de votre aide :-)


Windows / Edge 137.0.0.0

A voir également:

5 réponses

Réponse 1 / 5
Emi80110 Messages postés 68 Date d'inscription   Statut Membre Dernière intervention   2
 

C'est parfait 1000 merci !! :-)
1
Réponse 2 / 5
Bruno83200_6929 Messages postés 620 Date d'inscription   Statut Membre Dernière intervention   134
 

Bonjour,

Si vous travaillez sur une feuille spécifique (pas la feuille active), remplacez ActiveSheet par Worksheets("NomDeVotreFeuille").


Testez la macro sur un échantillon avant de l'appliquer à votre fichier complet pour vérifier qu'elle répond à vos attentes.

Sub SetPrintArea()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim printRange As String
    
    ' Définir la feuille active
    Set ws = ActiveSheet
    
    ' Trouver la dernière ligne non vide dans les colonnes A:E
    lastRow = ws.Range("A:E").Find(What:="*", _
                                   SearchOrder:=xlByRows, _
                                   SearchDirection:=xlPrevious, _
                                   LookIn:=xlValues).Row
    
    ' Définir la zone d'impression
    printRange = "A1:E" & lastRow
    ws.PageSetup.PrintArea = printRange
    
    ' Configurer l'impression : 1 page en largeur, automatique en longueur
    With ws.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = 0 ' 0 pour automatique
        .Orientation = xlPortrait
        .Zoom = False ' Désactiver le zoom pour utiliser FitToPages
    End With
    
    ' Optionnel : Aperçu avant impression
    ' ActiveSheet.PrintPreview
End Sub
0
Réponse 3 / 5
Emi80110 Messages postés 68 Date d'inscription   Statut Membre Dernière intervention   2
 

Bonjour Bruno

merci pour votre aide.

le code bug sur  .FitToPagesTall = 0 ' 0 pour automatique
0
Réponse 4 / 5
Emi80110 Messages postés 68 Date d'inscription   Statut Membre Dernière intervention   2
 

J'ai réussi a le débloquer.

Merci pour votre précieuse aide, ca fonctionne :-)
0
Bruno83200_6929 Messages postés 620 Date d'inscription   Statut Membre Dernière intervention   134
 

OK. Je suis heureux d'avoir pu vous apporter une aide modeste à votre projet. N'hésitez pas. 

0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
Bruno83200_6929 Messages postés 620 Date d'inscription   Statut Membre Dernière intervention   134
 

Je m'excuse pour l'erreur. En VBA, .FitToPagesTall = 0 n'est pas une valeur valide pour désactiver le redimensionnement en hauteur ; à la place, il faut utiliser False ou ne pas définir cette propriété pour permettre une longueur automatique. Voici une version corrigée de la macro :

Sub SetPrintArea()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim printRange As String
    
    ' Définir la feuille active
    Set ws = ActiveSheet
    
    ' Trouver la dernière ligne non vide dans les colonnes A:E
    lastRow = ws.Range("A:E").Find(What:="*", _
                                   SearchOrder:=xlByRows, _
                                   SearchDirection:=xlPrevious, _
                                   LookIn:=xlValues).Row
    
    ' Définir la zone d'impression
    printRange = "A1:E" & lastRow
    ws.PageSetup.PrintArea = printRange
    
    ' Configurer l'impression : 1 page en largeur, automatique en longueur
    ws.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = False ' Automatique en longueur
        .Orientation = xlPortrait
        .Zoom = False ' Désactiver le zoom pour utiliser FitToPages
    End With
    
    ' Optionnel : Aperçu avant impression
    ' ActiveSheet.PrintPreview
End Sub
0