Menu

VBA Excel > Macro imprimer cellule active

Sagekun84 - 9 févr. 2018 à 02:43 - Dernière réponse : f894009 13048 Messages postés dimanche 25 novembre 2007Date d'inscription 24 mai 2018 Dernière intervention
- 14 févr. 2018 à 07:44
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,
Afficher la suite 

Votre réponse

7 réponses

f894009 13048 Messages postés dimanche 25 novembre 2007Date d'inscription 24 mai 2018 Dernière intervention - 9 févr. 2018 à 14:06
0
Utile
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
f894009 13048 Messages postés dimanche 25 novembre 2007Date d'inscription 24 mai 2018 Dernière intervention - 12 févr. 2018 à 13:37
Bonjour,

Vous pouvez mettre votre fichier a dispo

Allez sur ce site : http://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/
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
f894009 13048 Messages postés dimanche 25 novembre 2007Date d'inscription 24 mai 2018 Dernière intervention - 13 févr. 2018 à 07:36
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
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 !
f894009 13048 Messages postés dimanche 25 novembre 2007Date d'inscription 24 mai 2018 Dernière intervention - 14 févr. 2018 à 07:44
Bonjour,

Ok
Commenter la réponse de f894009