VBA Excel > Macro imprimer cellule active

Sagekun84 -  
f894009 Messages postés 17417 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,

1 réponse

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    1. 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
    2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      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
    3. 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
    4. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      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
    5. 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
Enlever le pass. Telecomm. Active
Lisa -
Yves -

3 réponses