VBA Excel > Macro imprimer cellule active

Sagekun84 -  
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour a toute l'équipe,

Je sèche sur un petit souci, je vous explique,

J'ai une feuille excel qui est constituer de formule qui pioche des infos dans d'autres page.

Du coup, OP me voila lancer pour faire une macro qui imprime en paysage : 

Sub defimpression()

 'une page
Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.236220472440945)
        .RightMargin = Application.InchesToPoints(0.236220472440945)
        .TopMargin = Application.InchesToPoints(0.196850393700787)
        .BottomMargin = Application.InchesToPoints(0.196850393700787)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    
    Application.Dialogs(xlDialogPrint).Show
    
End Sub


Cela imprime mes 80 lignes (oui mes formules sont étirés jusqu’à la ligne 80 mais sont parfois vide) sauf que j'aimerais que ce stop jusqu’à la dernière cellule qui contient des datas.

Voici en photo mon tableau :
https://imgur.com/a/ewW6r

Du coup, comment faire ?


En vous remerciant pour votre aide,
A voir également:

1 réponse

Réponse 1 / 1
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour, 
Sub defimpression()
    Application.PrintCommunication = False
    With ActiveSheet
        'derniere cellule colonne O avec une valeur
        DerCell_Val = .Columns("O").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row 'une page
        With .PageSetup
            .PrintTitleRows = ""
            .PrintTitleColumns = ""
            .PrintArea = "$A$1 : $O$" & DerCell_Val           'plage a imprimer
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.236220472440945)
            .RightMargin = Application.InchesToPoints(0.236220472440945)
            .TopMargin = Application.InchesToPoints(0.196850393700787)
            .BottomMargin = Application.InchesToPoints(0.196850393700787)
            .HeaderMargin = Application.InchesToPoints(0.31496062992126)
            .FooterMargin = Application.InchesToPoints(0.31496062992126)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintSheetEnd
            .PrintQuality = 600
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlLandscape
            .Draft = False
            .PaperSize = xlPaperA4
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
            .PrintErrors = xlPrintErrorsDisplayed
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .ScaleWithDocHeaderFooter = True
            .AlignMarginsHeaderFooter = True
            .EvenPage.LeftHeader.Text = ""
            .EvenPage.CenterHeader.Text = ""
            .EvenPage.RightHeader.Text = ""
            .EvenPage.LeftFooter.Text = ""
            .EvenPage.CenterFooter.Text = ""
            .EvenPage.RightFooter.Text = ""
            .FirstPage.LeftHeader.Text = ""
            .FirstPage.CenterHeader.Text = ""
            .FirstPage.RightHeader.Text = ""
            .FirstPage.LeftFooter.Text = ""
            .FirstPage.CenterFooter.Text = ""
            .FirstPage.RightFooter.Text = ""
        End With
    End With
Application.PrintCommunication = True
Application.Dialogs(xlDialogPrint).Show
End Sub
0
Sagekun84
 
Salut f894009,

Malheureusement, cela ne fonctionne pas.
En effet, ça imprime les 80 lignes alors que je n'ai que 15 lignes de remplis today
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Vous pouvez mettre votre fichier a dispo

Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...

ou
'mon partage
https://mon-partage.fr/
0
Sagekun84
 
Bonjour,

Le voici (document dispo pendant 4 jours / en privé) :
https://www.cjoint.com/c/HBmuYM7YoW2

Des infos ont été retiré car confidentiel.
Et normalement les query ne fonctionnerons pas.

Il faut savoir que les query permettent de choper des datas de stock et la 1er page permet de tout compiler
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Dans vos formules des blancs sont consideres comme des valeurs..............................
Donc pourquoi des blancs " " ald "" pour "dire" vide......................!!!!!!!!!!!!!!!

Mettez sierreur devant vos formule moyenne pour eviter les #div/0
0
Sagekun84
 
Punaise ! Erreur de débutant pour les formules ......

Formule changé en virant l'espace dans les "" comme ça ce n'est pas considéré comme des cell active
Modification de la formule calcule de moyen pour enlever le #div/0

Modification du code initiale car la valeur =0 n'été que dans 1 colonne et non sur l’ensemble : 
Sub defimpression()
    Application.PrintCommunication = False
    With ActiveSheet
        'derniere cellule colonne O avec une valeur
        DerCell_Val = .Columns("B:L").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
        With .PageSetup
            .PrintTitleRows = ""
            .PrintTitleColumns = ""
            .PrintArea = "$A$1 : $L$" & DerCell_Val
            
        'plage a imprimer
        
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.236220472440945)
            .RightMargin = Application.InchesToPoints(0.236220472440945)
            .TopMargin = Application.InchesToPoints(0.196850393700787)
            .BottomMargin = Application.InchesToPoints(0.196850393700787)
            .HeaderMargin = Application.InchesToPoints(0.31496062992126)
            .FooterMargin = Application.InchesToPoints(0.31496062992126)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintSheetEnd
            .PrintQuality = 600
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlPortrait
            .Draft = False
            .PaperSize = xlPaperA4
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
            .PrintErrors = xlPrintErrorsDisplayed
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .ScaleWithDocHeaderFooter = True
            .AlignMarginsHeaderFooter = True
            .EvenPage.LeftHeader.Text = ""
            .EvenPage.CenterHeader.Text = ""
            .EvenPage.RightHeader.Text = ""
            .EvenPage.LeftFooter.Text = ""
            .EvenPage.CenterFooter.Text = ""
            .EvenPage.RightFooter.Text = ""
            .FirstPage.LeftHeader.Text = ""
            .FirstPage.CenterHeader.Text = ""
            .FirstPage.RightHeader.Text = ""
            .FirstPage.LeftFooter.Text = ""
            .FirstPage.CenterFooter.Text = ""
            .FirstPage.RightFooter.Text = ""
        End With
    End With
Application.PrintCommunication = True
Application.Dialogs(xlDialogPrint).Show
End Sub


Encore merci de votre aide, cela fonctionne correctement !
0

Discussions similaires

Excel formule : savoir si une cellule contient partie texte
plunderer007 -
francois -

14 réponses