Microsoft 365 Code VBA pour créer une impression de plusieur onglet

[Fanaouer]

Bonjour,

J’essaie de créer un aperçu avant impression avec plusieurs feuilles excel selon un critère.

C'est à dire j’aimerai pouvoir sélectionner certain onglet et lancer la macro et celle ci me créer un aperçu avant impression avec tout les onglets demandé, ainsi que la première page nommé Liste machine.

Je vous met en annexe le fichier que j'ai commencé à créer.

J'ai déjà une macro qui me crée un aperçu pour chaque onglet mais il me le fait une page à la fois.

et moi j'aimerai imprimer toute les pages ou j'ai mis impression "oui" ainsi que la liste machine en premier

Merci d'avance pour vos réponses.

 

[Jacky67]

Bonjour,

J’essaie de créer un aperçu avant impression avec plusieurs feuilles excel selon un critère.

C'est à dire j’aimerai pouvoir sélectionner certain onglet et lancer la macro et celle ci me créer un aperçu avant impression avec tout les onglets demandé, ainsi que la première page nommé Liste machine.

Je vous met en annexe le fichier que j'ai commencé à créer.

J'ai déjà une macro qui me crée un aperçu pour chaque onglet mais il me le fait une page à la fois.

et moi j'aimerai imprimer toute les pages ou j'ai mis impression "oui" ainsi que la liste machine en premier

Merci d'avance pour vos réponses.

Bonjour,
On ne peut pas avoir un aperçu avant impression de feuilles multiples
Une proposition en PJ avec ce code avec impression direct et suppression de la feuille "Liste impression"

Sub imprime()
    Dim C As Range
    With Feuil2
        .PrintOut
        For Each C In .Range("b3:b" & .Range("b" & .Rows.Count).End(xlUp).Row)
            If C.Value <> "" And C.Offset(, 1) <> "" And UCase(Trim(C.Offset(, 2))) = "OUI" Then
                On Error GoTo erreur
                'Sheets(C.Offset(, 1).Value).PrintPreview
                'Valider la ligne ci-dessous pour imprimer et supprimer celle ci-dessus
               Sheets(C.Offset(, 1).Value).PrintOut
            End If
        Next
    End With
    Exit Sub
erreur:
    MsgBox "Feuille " & C.Offset(, 1) & " inexistante"
    Resume Next
End Sub

 

[job75]

Bonjour Fanaouer, Jacky67,

On ne peut pas avoir un aperçu avant impression de feuilles multiples

Si, comme ceci :

Sub Imprimer()
Dim plage As Range, c As Range, dest As Range, w As Worksheet
On Error Resume Next 'si une feuille n'existe pas
With Sheets("Liste Machine")
    Set plage = .Range("A1", .UsedRange)
    Set dest = .Cells(plage.Row + plage.Rows.Count + 1, 2) 'décalage d'une ligne
    For Each c In plage.Columns(4).Cells
        If LCase(c) = "oui" Then
            Set w = Nothing
            Set w = Sheets(CStr(c(1, 0)))
            w.UsedRange.Copy dest
            Set dest = dest(w.UsedRange.Count + 2) 'décalage d'une ligne
        End If
    Next
    .PrintPreview 'aperçu avant impression
    '.PrintOut 'impression
    .Rows(plage.Row + plage.Rows.Count & ":" & .Rows.Count).Delete 'RAZ
End With
End Sub

Si les tableaux des feuilles ont des colonnes différentes il faudra voir pour les largeurs...

A+

 

[Jacky67]

Si, comme ceci :

Hello job75
J'aurais du écrire
On ne peut pas avoir un aperçu avant impression de feuilles multiples ......nativement
Merci d'avoir rectifié

 

[fanch55]

Salut à tous,
Je suis surpris, ceci fonctionne :

ActiveWindow.SelectedSheets.PrintPreview

 

[fanch55]

A tester

 

[job75]

Bonjour fanch55, le fil,

Pourquoi un code si compliqué ? Faire une sélection multiple c'est simple :

Sub Imprimer()
Dim c As Range, w As Worksheet
On Error Resume Next 'si une feuille n'existe pas
With Sheets("Liste Machine")
    .Select
    For Each c In .Range("A1", .UsedRange).Columns(4).Cells
        If LCase(c) = "oui" Then Sheets(CStr(c(1, 0))).Select False 'sélection multiple
    Next
    ActiveWindow.SelectedSheets.PrintPreview 'aperçu avant impression
    'ActiveWindow.SelectedSheets.PrintOut 'impression
    .Select
End With
End Sub

Fichier (2).

A+

 

[fanch55]

@job75
C''est vrai quand on veut imprimer toujours les mêmes onglets et s'ils sont tous visibles.
C''est moins évident quand des onglets sont masqués .
Le post du https://www.excel-downloads.com/thr...on-de-plusieur-onglet.20048205/#post-20354801 est évolutif

 

[job75]

C''est vrai quand on veut imprimer toujours les mêmes onglets et s'ils sont tous visibles.

Toujours les mêmes onglets ?

Au post #7 seuls les onglets notés "oui" sont imprimés à condition d'être visibles.

 

[fanch55]

Toujours les mêmes onglets ?
Au post #7 seuls les onglets notés "oui" sont imprimés à condition d'être visibles.

Mes excuses Job, ce que je voulais éviter c'est de mettre en dur le nom des feuilles qqpart et de pouvoir imprimer les feuilles masquées .
==> sub à trois fonctions : toutes les feuilles, les feuilles visibles, et les feuilles masquées.
Un peu inutile: si on signale directement les feuilles masquées, le code se simplifie significativement.
D'un autre coté, si une nouvelle feuille apparait, elle est prise en compte immédiatement.
A contrario, il faut cocher à chaque fois, pas de mise en mémoire à moins de charger une forme .

Votre feuille devrait pouvoir être améliorée en détectant automatiquement les nouvelles feuilles et celles inexistantes dans le tableau .

 

[job75]

Votre feuille devrait pouvoir être améliorée en détectant automatiquement les nouvelles feuilles et celles inexistantes dans le tableau .

Perso je n'appelle pas ceci une amélioration :

Sub Imprimer()
Dim c As Range, w As Worksheet
On Error Resume Next 'si une feuille n'existe pas
With Sheets("Liste Machine")
    .Select
    For Each c In .Range("A1", .UsedRange).Columns(4).Cells
        If LCase(c) = "oui" Then
            Set w = Nothing
            Set w = Sheets(CStr(c(1, 0)))
            If w Is Nothing Then MsgBox "La feuille '" & CStr(c(1, 0)) & "' n'existe pas !", 48
            If w.Visible <> xlSheetVisible Then MsgBox "La feuille '" & w.Name & "' est masquée..."
            w.Select False 'sélection multiple
        End If
    Next
    ActiveWindow.SelectedSheets.PrintPreview 'aperçu avant impression
    'ActiveWindow.SelectedSheets.PrintOut 'impression
    .Select
End With
End Sub

car les messages c'est plutôt casse-pieds. non ?

 

[fanch55]

Les messages sont casse-pieds assurément .
Ce que je voulais dire par détecter, c'est par exemple
si la feuille n'existe plus ou pas, enlever le oui

Select Case True
    Case W is nothing : c= "Non Trouvé"
    Case not W.visible: c= "masquée"
    Case else: W.select False
End select

 

[job75]

i la feuille n'existe plus ou pas, enlever le oui

Perso je mettrais plutôt un commentaire en colonne C, fichier (2) :

Sub Imprimer()
Dim c As Range, w As Worksheet
On Error Resume Next 'si une feuille n'existe pas
With Sheets("Liste Machine")
    .Columns(3).Replace " / Inexistant", "", xlPart
    .Columns(3).Replace " / Masqué", ""
    .Select
    For Each c In .Range("A1", .UsedRange).Columns(4).Cells
        If LCase(c) = "oui" Then
            Set w = Nothing
            Set w = Sheets(CStr(c(1, 0)))
            If w Is Nothing Then c(1, 0) = c(1, 0) & " / Inexistant"
            If w.Visible = xlSheetVisible Then Else c(1, 0) = c(1, 0) & " / Masqué"
            w.Select False 'sélection multiple
        End If
    Next
    .Columns(3).AutoFit 'ajustement largeur
    ActiveWindow.SelectedSheets.PrintPreview 'aperçu avant impression
    'ActiveWindow.SelectedSheets.PrintOut 'impression
    .Select
End With
End Sub

 

[fanch55]

Ben voilà, mais il faudrait que le demandeur se manifeste ...

Une dernière chose, il serait peut-être judicieux de faire un
Sheets("Liste machine").Move Before:=Sheets(1) avant de faire le premier select ,
car le selectedsheets prend les feuilles dans leur ordre d'apparition dans le classeur et non pas dans l'ordre de selection ...

 

[job75]

car le selectedsheets prend les feuilles dans leur ordre d'apparition dans le classeur et non pas dans l'ordre de selection ...

Bah on n'est pas obligé de sélectionner les feuilles, on peut les imprimer une par une :

Sub Imprimer()
Dim n%, c As Range, w As Worksheet, a$(), e
On Error Resume Next 'si une feuille n'existe pas
With Sheets("Liste Machine")
    .Columns(3).Replace " / Inexistant", "", xlPart
    .Columns(3).Replace " / Masqué", ""
    n = n + 1
    ReDim a(1 To 1)
    a(1) = .Name
    For Each c In .Range("A1", .UsedRange).Columns(4).Cells
        If LCase(c) = "oui" Then
            Set w = Nothing
            Set w = Sheets(CStr(c(1, 0)))
            If w Is Nothing Then c(1, 0) = c(1, 0) & " / Inexistant"
            If w.Visible = xlSheetVisible Then Else c(1, 0) = c(1, 0) & " / Masqué"
            n = n + 1
            ReDim Preserve a(1 To n)
            a(n) = w.Name
        End If
    Next
    .Columns(3).AutoFit 'ajustement largeur
    '---impression feuille par feuille---
    For Each e In a
        Sheets(e).PrintPreview 'aperçu avant impression
        'Sheets(e).PrintOut 'impression
    Next
    .Activate
End With
End Sub

Fichier (4).