VBA Excel > Macro imprimer cellule active - Forum VB / VBA

VBA Excel > Macro imprimer cellule active Macro VBA Excel pour imprimer sans ouvrir » Forum - VB / VBA VBA Excel - Nombre de cellules selon leur couleur » Conseils pratiques - Visual Basic [VBA Excel] Macro quand ajout ou supprime ligne (Résolu) » Forum - VB / VBA Vba excel macro aujourd'hui (Résolu) » Forum - Excel VBA excel Copie valeur cellule avc condition (Résolu) » Forum - VB / VBA

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,

Forum

VBA Excel > Macro imprimer cellule active Macro VBA Excel pour imprimer sans ouvrir » Forum - VB / VBA VBA Excel - Nombre de cellules selon leur couleur » Conseils pratiques - Visual Basic [VBA Excel] Macro quand ajout ou supprime ligne (Résolu) » Forum - VB / VBA Vba excel macro aujourd'hui (Résolu) » Forum - Excel VBA excel Copie valeur cellule avc condition (Résolu) » Forum - VB / VBA

Web: www.shapebootstrap.net

7 réponses

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

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

Reply
réponses:
  • auteur

  • auteur

    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

  • f894009

    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/

  • auteur

    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

    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

  • auteur

    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

    Bonjour,

    Ok

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed