VBA pour printout identique à 'fichier_imprimer' excel 2010

[dmc]

Bonjour le forum
Je cherche à obtenir la même présentation de lancement d'impression sous excel 2010, mais à partir d'un menu contextuel, déjà créé via la macro suivante dans le code de la feuille:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
        Cancel As Boolean)
    Dim icBc As Object, LigFin As Single
    CommandBars("Cell").Reset
    CommandBars("row").Reset

        With Application.CommandBars("cell").Controls _
                    .Add(Type:=msoControlButton, Before:=15, temporary:=True)
            .ShortcutText = "Ctrl+Maj+P"
            .TooltipText = "imprimer "
            .BeginGroup = True
            .Caption = "Imprimer "
            .OnAction = "impression"
            .Tag = "dnimpression"
            .Visible = True
        End With

End Sub

Public Sub impression()
    'Application.Dialogs(xlDialogPrintPreview).Show (tentatives diverses d'appel de print out ou preview)
    'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    'ActiveSheet.PrintPreview
    'Application.Dialogs(xlDialogPrinterSetup).Show
    ActiveWindow.SelectedSheets.PrintOut Preview:=True, Collate:=True


End Sub

mais je ne parviens pas à obtenir la même présentation, à savoir un aperçu s'accompagnant en particulier de la possibilité de choisir l'imprimante .
Je précise que je procède à des enrichissements avant impression, et que je les supprime après.
Enfin, comme l'utilisateur travaille en mode Application.DisplayFullScreen = true, le menu d'excel ne lui est pas accessible systématiquement, mais je souhaite lui conserver les mêmes fonctionnalités que l'impression "native" d'excel 2010.
A toutes fins utiles, je joins le fichier dans lequel sont placées les 2 (petites) macros évoquées.
Auriez-vous la solution à mon besoin ?
D'avance merci de me décoincer, je cherche partout sans succès.
DMC is in the street !😛

 

[dmc]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonjour au forum
😕 Manifestement j'ai peu de succès avec ma question !😕
Je suis prêt à fournir d'autres explications, si celles-ci ne suffisent pas.😀
Merci à tous.
PS : en fait ceci ressemble étrangement à un "UP", si je ne me trompe ?😱
Amicalement
DMC

 

[dmc]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

bon ben là c'est chou-blanc ! pas le moindre souffle, ni brise, ni rien !
mais sans doute qu'un excellien finira par me retourner un petit message d'encouragement ?
non ? si.
si si

 

[Staple1600]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonsoir à tous

dmc
Une question:
Y-a-t-il une procédure WorkBook_Open() dans ta pièce jointe?
Si oui, que fait-elle?
Si elle fait ce que je crois qu'elle fait, cela explique peut-être pourquoi (ce qui est mon cas) les habitués n'ouvrent pas ta pièce jointe.


PS : Pour être plus explicite:
De quel droit, tu t'autorises à :
CommandBars("Cell").Reset
CommandBars("row").Reset

Qui te dit que j'ai pas des personnalisations de mon menu Contextuel sur mon PC ... 🙄 ?

 

[dmc]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonsoir Staple
Non, pas de workbook_open dans le fichier joint
En fait, j'ai pris la peine de joindre un fichier "dégraissé" au maximum, néanmoins j'ai gardé l'accès via le BeforeRightClick c'est pourquoi il y a le reset des menus du clic droit.
Je ne pensais pas commettre un impair, d'autant plus que le code est affiché en clair dans mon message.
A la finale, je souhaitais être le plus proche possible de mon contexte de travail avant de demander une aide.
Dois-je fournir un fichier avec une boite de dialogue en lieu et place de ce clic droit ?

 

[Staple1600]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonsoir à tous

dmc
Pour choisir l'imprimante, essaies-ceci

Sub a()
cdbA = Application.Dialogs(8).Show
End Sub

Pour paramétrer l'impression

Sub b()
cdbB = Application.Dialogs(9).Show
End Sub

 

[dmc]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonjour le Forum, et Staple1600, que je remercie de chercher pour moi.
Staple : j'ai déjà testé ces valeurs, mais elles ne donnent pas l'équivalent de la fenêtre obtenue lorsque l'on choisit l'option Imprimer du menu fichier d'excel. Le tableau ci-après reprend toutes les lignes XlBuiltInDialog comprenant la chaine impr :Énumération XlBuiltInDialog
[TABLE="width: 565"]
[TR]
[TD="align: center"]Nom[/TD]
[TD="align: center"]Valeur[/TD]
[TD="align: center"]Description[/TD]
[/TR]
[TR]
[TD]xlDialogPrint[/TD]
[TD="align: center"]8[/TD]
[TD]Boîte de dialogue Imprimer[/TD]
[/TR]
[TR]
[TD]xlDialogPrinterSetup[/TD]
[TD="align: center"]9[/TD]
[TD]Boîte de dialogue Configuration de l'imprimante[/TD]
[/TR]
[TR]
[TD]xlDialogSetPrintTitles[/TD]
[TD="align: center"]23[/TD]
[TD]Boîte de dialogue Définir les titres d'impression[/TD]
[/TR]
[TR]
[TD]xlDialogPrintPreview[/TD]
[TD="align: center"]222[/TD]
[TD]Boîte de dialogue Aperçu avant impression[/TD]
[/TR]
[/TABLE]

ce que je souhaite afficher ressemble à cela :

avec une petite boucle vba, j'ai testé toutes les valeurs de dialogs entre 0 et 1213 (Application.Dialogs.Count) sans trouver une seule fenêtre identique à celle montrée en miniature.

Je change mon fusil d'épaule ou la nature de ma demande :
Voilà ce que je souhaite mettre en place :

1. avant l'impression, insérer les sous-totaux dans le document ( événement BeforePrint)
2. permettre à l'utilisateur :
   • de voir l'aperçu avec les sous-totaux avant de lancer l'impression;
   • de décider pendant cet aperçu :
     • s'il renonce à imprimer;
     • s'il imprime;
     • s'il change d'imprimante;
     • s'il change d'orientation Portrait ou paysage.
3. s'il renonce ou imprime :
   • après impression éventuelle, supprimer les sous-totaux avant de rendre la main.
4. s'il a changé d'imprimante ou d'orientation :
   • supprimer les sous-totaux;
   • insérer les sous-totaux à leur nouvel emplacement, la rupture de page ne se faisant pas nécessairement sur la même ligne;
   • revenir à la phase 2.

Le code suivant est largement inspiré de mes incursions sur ExcelDownloads, à qui je dois tout ce que je sais en VBA, même si cela est loin loin très loin d'être parfait, j'attends d'ailleurs vos corrections.
Ce code permet actuellement, s'il est appelé via "Fichier-Imprimer" :

1. de permettre à l'utilisateur :
   1. de voir l'aperçu SANS les sous-totaux (dommage) avant de lancer l'impression ;
   2. de décider pendant cet aperçu :
      • s'il change d'imprimante;(bien)
      • s'il change d'orientation Portrait ou paysage;(pas indispensable)
      • s'il renonce à imprimer;(bien)
      • s'il imprime.(bien)
      • les autres options ne sont pas indispensables
2. si l'utilisateur renonce :
   1. de supprimer les sous-totaux avant de rendre la main : tout est ok
3. si l'utilisateur choisit d'imprimer :
   1. d'insérer avant l'impression les sous-totaux dans le document : tout est ok
   2. d'afficher un deuxième aperçu avec sous-totaux : 2 aperçus différents, ça pas terrible
   3. dans ce deuxième aperçu, l'utilisateur peut décider :
      1. s'il change orientation Portrait paysage ou marges (pas indispensable):
         1. emplacement des sous-totaux foireux ;
      2. s'il renonce à imprimer : tout est ok
      3. s'il imprime (tout est ok) mais sans pouvoir changer d'imprimante ça pas terrible :
      • 1. imprimer : tout est ok sauf si orientation ou marges modifiées
        2. supprimer les sous-totaux dans le document : tout est ok
        3. rendre la main : tout est ok

Ce code appelé par un bouton pointant vers la macro "impression" passe directement à l'étape 3 du processus décrit ci-avant. Ceci me conviendrait si le choix d'imprimante était donné à ce moment-là.

Le bilan de l'existant :
- si je pouvais procéder à l'enrichissement sous-totaux avant le 1er aperçu, et à chaque modification faite par l'utilisateur pendant la phase 1, je ne vous solliciterais même pas !
- si le deuxième aperçu me permettait d'intercepter les modifications de l'utilisateur et de choisir l'imprimante, il me conviendrait parfaitement.
Qu'en pensez-vous ?

• code dans les événements de la feuille :

Private Sub Workbook_BeforePrint(Cancel As Boolean)      'dans les événements de la feuille
    If Imprim_en_Cours = True Then Exit Sub
    Imprim_en_Cours = True
    Call impression
    Cancel = True
    Imprim_en_Cours = False
End Sub

• code dans un module :

Public Imprim_en_Cours As Boolean     ' dans un module
Public Sub impression()
    Imprim_en_Cours = True
    Call InserST(True)
    ActiveWindow.SelectedSheets.PrintOut Preview:=True
    Call InserST(False)
    Imprim_en_Cours = False
End Sub

Public Sub InserST(Optional ByVal supprSautPage As Boolean)
Dim C As Range
Dim i As Integer


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
                'Suppression des sous-totaux
With ActiveSheet.Range("$A$1:H" & Range("C" & Application.Rows.Count).End(xlUp).Row)
    Do     ' suppression des sous-totaux existants
        Set C = .Find(What:="-Total", _
                            After:=Cells(1, 1), LookIn:=xlValues, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False)
        If Not C Is Nothing Then
            Cells(C.Row, "A").EntireRow.Delete
        End If
    Loop While Not C Is Nothing
End With
ActiveSheet.ResetAllPageBreaks      ' suppression des sauts de page existants
While ActiveSheet.HPageBreaks.Count > 0 And i < 5      ', avec forcing car parfois ça ne suffit pas !
    On Error Resume Next
        ActiveSheet.HPageBreaks(1).Delete       'suppression des sauts de page horizontaux
    On Error GoTo 0
    i = i + 1
Wend    ' je sais, c'est pas beau !
Application.ScreenUpdating = True
                ' Partie 2 : Définition auto de la zone d'impression
ActiveSheet.PageSetup.PrintArea = "$A$1:H" & Range("G" & Application.Rows.Count).End(xlUp).Row
                ' Partie 3 : gestion des sauts de page
If supprSautPage Then
    Call GestSautPage
End If
ActiveSheet.PageSetup.PrintArea = "$A$1:H" & Range("G" & Application.Rows.Count).End(xlUp).Row
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub


Public Sub GestSautPage()
Dim LigFin As Integer, ligBas As Integer, ligTrav As Integer, colTrav As Integer
Dim Cpb As Range, PBinit As Byte
PBinit = 0
LigFin = [rem_moteur].Row - 1     ' détermine dernière ligne à totaliser
ligBas = Range("G" & Application.Rows.Count).End(xlUp).Row   ' détermine dernière ligne du document
While PBinit <= ActiveSheet.HPageBreaks.Count
    i = PBinit + 1
    On Error GoTo Sortie     ' pas beau pas beau là aussi je patauge, pas précis
    If ActiveSheet.HPageBreaks(i).Extent = xlPageBreakPartial Then
        If ActiveSheet.HPageBreaks(i).Location.Row < LigFin Then
            ligTrav = ActiveSheet.HPageBreaks(i).Location.Row
            Range("A" & ligTrav - 1).EntireRow.Insert (xlShiftDown)
               ' reste à faire : si hauteur ligtrav-1  supérieure à 1 ligne alors insérer saut de page
               ' ActiveSheet.HPageBreaks.Add Before:=Range("A" & ligTrav) reste à mettre au point
               ' ou forcer hauteur de ligne insérée = celle de ligtrav-1: meilleure solution sans doute
            Range("A" & ligTrav).EntireRow.Insert (xlShiftDown)
            GoSub lignesST
            LigFin = LigFin + 2
            PBinit = i
        Else
            Range("A" & LigFin).EntireRow.Insert (xlShiftDown) 
            Range("A" & LigFin).EntireRow.Insert (xlShiftDown)
            ActiveSheet.HPageBreaks.Add Before:=Range("a" & LigFin + 1)
            ligTrav = ActiveSheet.HPageBreaks(i).Location.Row
            GoSub lignesST
            LigFin = LigFin + 2
            PBinit = i
            Exit Sub
        End If
    End If
    On Error GoTo Sortie
Wend
Sortie: Exit Sub
lignesST:
            Cells(ligTrav - 1, "C") = "Sous-Total à reporter:"
            Range("G" & ligTrav - 1 & ":H" & ligTrav - 1).Merge
            Cells(ligTrav - 1, "G").FormulaR1C1 = "=SUBTOTAL(9,R2C8:R[-1]C8)"
            Cells(ligTrav, "C") = "Report du Sous-Total :"
            Range("G" & ligTrav & ":H" & ligTrav).Merge
            Cells(ligTrav, "G").FormulaR1C1 = "=SUBTOTAL(9,R2C8:R[-2]C8)"
            With Range(Cells(ligTrav - 1, "A"), Cells(ligTrav, "C"))
                 .HorizontalAlignment = xlRight
            End With
            With Range(Cells(ligTrav - 1, "A"), Cells(ligTrav, "H"))
                .Interior.ColorIndex = 20
                .Font.Bold = True
            End With
            With Range(Cells(ligTrav - 1, "A"), Cells(ligTrav - 1, "H"))
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    .ColorIndex = 5
                End With
            End With
            With Range("G" & ligTrav - 1 & ":G" & ligTrav)
                .NumberFormat = "#,##0.00 $;[Red]-#,##0.00 $;"
            End With
Return
End Sub

Pour que ce code fonctionne :

• créer une zone nommée rem_moteur sur la feuille, se référant à la ligne 80 par exemple,
• placer en colonne H de la ligne 2 à 79 (80 - 1) quelques valeurs quelconques à totaliser.

J'espère avoir été complet et clair pour cette demande, et que vous saurez me donner l'aide dont j'ai besoin.
Merci d'avance.

 

[Staple1600]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonsoir à tous

dmc
Drôle de façon de faire des sous-totaux 😉
Essaie juste pour voir (dans un classeur vierge) la macro test
(sans oublier de copier les 3 autres macros dans un module Standard)


[TABLE="width: 620"]
[TR]
[TD]Sub test()
Application.ScreenUpdating = False
datagenerator
Application.ScreenUpdating = True
MsgBox "Appliquer les sous-totaux?", vbQuestion + vbOKOnly, "ETAPE 1"
AjoutSOUSTOTAUX
MsgBox "R.A.Z -> sous-totaux ?", vbQuestion + vbOKOnly, "ETAPE 2"
EFFACER_SOUSTOTAUX
MsgBox "C'est comme cela que je fais des sous-totaux ;o)", vbExclamation, "FIN TEST"
Cells.Clear
End Sub[/TD]
[TD]Private Sub datagenerator()
Dim i: Cells.Clear
[B1:H1] = Array("COL1", "COL2", "COL3", "COL4", "COL5", "COL6", "COL7")
For i = 1 To 27 Step 2
Cells(i, "A").Resize(i * 2) = "ITEM" & 1 + Int(i * Time)
Next i
[A1] = "ITEMS"
With [B2:H80]
.Value = "=ROW()*COLUMN()"
.Value = .Value
End With
End Sub
[/TD]
[/TR]
[TR]
[TD]Private Sub AjoutSOUSTOTAUX()
[A1].CurrentRegion.Sort Key1:=Range("A2"), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
[A1].CurrentRegion.Subtotal GroupBy:=1, _
Function:=xlSum, TotalList:=Array(2, 3, 4, 5, 6, 7, 8), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
End Sub[/TD]
[TD]Private Sub EFFACER_SOUSTOTAUX()
Dim pf As Range
ActiveSheet.Outline.ShowLevels RowLevels:=3
[A1].AutoFilter Field:=1, Criteria1:="=Total*", _
Operator:=xlAnd
Set pf = [_FilterDataBase]
pf.Offset(1).Resize(pf.Rows.Count).SpecialCells(12).EntireRow.Delete _
Shift:=xlUp
ActiveSheet.AutoFilterMode = False
Cells.ClearOutline
End Sub[/TD]
[/TR]
[/TABLE]

 

[dmc]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonjour le forum, bonjour et merci à Staple1600
J'ai bien essayé ton code, qui m'apprend beaucoup sur d'autres techniques de programmation. C'est beau, c'est concis, et je ne comprends pas toutes les instructions, en particulier :
- Set pf = [_FilterDataBase] : je ne trouve pas cette zone nommée- pf.Offset(1).Resize(pf.Rows.Count).SpecialCells(12).EntireRow.Delete Shift:=xlUp : je comprends bien que tu utilises les cellules visibles, mais si tu veux bien m'expliquer le fonctionnement de cette instruction, je ne suis pas familiarisé avec le resize, je ne comprends pas le décalage offset(1)... et la logique de cet ensemble.
Pour le reste :
Bien entendu je me suis mal expliqué :
- les sous-totaux que j'insère sont des sous-totaux par page, provoqués par la rupture de page, et non pas par la rupture de données telles que tu me le montres. Et ces sous-totaux ne sont pas remis à 0 à chaque page, chaque sous-total reprend la somme de l'intégralité des pages qui le précèdent.
- ces sous-totaux se composent :

- d'une première ligne , libellée "Sous-Total à reporter:", se situant au bas de la feuille que l'on quitte​

- et d'une seconde ligne, libellée "Report du Sous-Total :", située en haut de la page suivante.​

c'est pourquoi dans ma routine GestSautPage() je cherche l'emplacement de la rupture de page, et qu'une fois trouvée je prends la ligne précédente pour insérer à cet emplacement ma première ligne de sous-total par page.
Si tu veux bien tester le code de mon post précédent, tu verras que l'on obtient bien ce résultat. Ce code est sans danger et n'intervient pas sur ton environnement.
- par contre, ton module de suppression des sous-totaux peut peut-être me convenir. Bien entendu, il semble bien plus performant que le mien, à condition qu'il puisse également supprimer les sauts de page, et surtout qu'il ne soit pas dépendant de filtres (Outline.ShowLevels) que pour ma part je n'utilise pas sur ces documents car je n'en ai pas besoin. Mais là encore, je n'ai sans doute pas tout compris !
C'est dur d'être mauvais ! Mais je compte sur toi pour progresser.😀
Alors j'attends tes commentaires, et ton aide.
D'avance, encore merci
Cordialement

 

[Staple1600]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonjour à tous

dmc:
Je n'ai pas testé car j'attends ton fichier joint (car j'ai présupposé que ta première pièce jointe ne correspondait plus à ton dernier code mais peut-être me trompe-je)

Pour répondre à ta question:
Set pf = [_FilterDataBase]
pf.Offset(1).Resize(pf.Rows.Count).SpecialCells(12 ).EntireRow.Delete _
Shift:=xlUp

"_FilterDataBase" est une plage nommée masquée créée par Excel
lorsque un filtre (automatique ou élaboré) est appliqué et représente la plage de cellules filtrée.

Le reste (Offset et resize) permet de supprimer le résultat du filtre tout en gardant l'entête.

PS: Les codes ci-dessous ne sont qu'illustratifs et commis parce que je n'avais pas de fichier à me mettre sous la main 😉

 

[dmc]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Merci Staple pour tes explications, lumineuses (c'est sérieux de ma part)
Pour le code tu peux y aller, il n'y a pas de variation , je l'ai réalisé en expurgeant des mes feuille normales tout ce qui n'était pas dans le sujet.
(Le code d'origine prend 27 pages d'impression, mais c'est surtout que les feuilles contiennent des données sensibles pour moi et que les maquiller prendrait du temps, je pense d'ailleurs à une petite macro pour les dénaturer automatiquement et pouvoir envoyer le résultat sur exceldownloads en toute tranquillité).
Néanmoins, si cela t'arrange, je suis prêt à te joindre un fichier, je dois juste le reconstituer à la façon que j'indique dans mon post, depuis l'autre jour j'ai cassé ce modèle car je m'en sers pour différents tests.
Dans l'attente de ta réponse

 

[Staple1600]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonjour à tous

dmc

je pense d'ailleurs à une petite macro pour les dénaturer automatiquement et pouvoir envoyer le résultat sur exceldownloads en toute tranquillité).

J'ai cela en magasin d'ailleurs j'avais posté cela sur XLD il y un bail déjà 🙂 (en 2008 pour être précis)
Le fil: ANONYMIZATOR

Le fichier: [Lien supprimé]

Sinon donc pour aller plus loin, merci :
- d'ajouter une pièce jointe actualisée qui contenant:
* le code VBA de ce message
* les données et la zone nommée dont tu parles ici.

Pour que ce code fonctionne :

• créer une zone nommée rem_moteur sur la feuille, se référant à la ligne 80 par exemple,
• placer en colonne H de la ligne 2 à 79 (80 - 1) quelques valeurs quelconques à totaliser.

et assures toi que la structure de ton classeur joint est en adéquation avec le code VBA utilisé
(nom des feuilles exact, userforms inclus si besoin etc...)

 

[dmc]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonjour Staple1600, et le forum
Staple :
j'ai joint le fichier demandé, contenant le code. Je l'ai testé il fonctionne, sauf si tu passes par l'impression du menu excel, pour une raison qui m'échappe, mon ordinateur à la maison (Windows 8 et version évaluation Excel 2013) sur lequel je travaille ce lundi n'intercepte pas le beforeprint !
Néanmoins je te l'envoie car pour le reste il est conforme à mon descriptif, et à mon cahier des charges. Pas de USF, car je n'y connais rien.
Merci de t'y pencher.
DMC

 

[Staple1600]

Re : VBA pour printout identique à 'fichier_imprimer' excel 2010

Bonsoir à tous

dmc
[TABLE="width: 695"]
[TR]
[TD]Regarde la pièce jointe 880686[/TD]
[TD]Je ne vois plus le rapport actuel
avec ton dernier code
(issu de ta dernière pièce jointe)

<= Il n'est plus question de faire
apparaître cette boite de dialogue?[/TD]
[TD]

Ni avec ce que tu disais dans ton premier message:

mais je ne parviens pas à obtenir
la même présentation, à savoir un aperçu
s'accompagnant en particulier de
la possibilité de choisir l'imprimante .

​

[/TD]
[/TR]
[/TABLE]