Aperçu avant imprim sur USF

petchy

XLDnaute Occasionnel
Bonjour
quand j'ouvre mon usf j'ai une listbox qui affiche mes feuilles
Private Sub UserForm_Initialize()
Application.EnableEvents = False
LbClasseurs.Value = ActiveWorkbook.Name
Application.EnableEvents = True
End Sub
ensuit en cochant la ou les feuilles je les imprime
Private Sub CmdImprimer_Click()
Application.ScreenUpdating = False
For I = 0 To LbFeuilles.ListCount - 1
If LbFeuilles.Selected(I) = True Then
Application.StatusBar = "Impression: " & LbFeuilles.List(I)
Application.DisplayAlerts = False
Sheets(LbFeuilles.List(I)).PrintOut
Else
End If
Next I
Unload Me
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
est ce possible de faire un aperçu avant de les imprimer
c'est a dire en rajoutant un bouton sur l'usf, je puisse visualiser la ou les feuilles que j'ai cocher.
merci
 

petchy

XLDnaute Occasionnel
Re : Aperçu avant imprim sur USF

Re
merci pour ta réponse
mais j'ai un petit soucis,l'usf ne se ferme pas et je suis obliger de faire un alt ctrl sup,pour fermer
pourtant j'ai rajouter un unload me ou un hide
mais rien à faire.
aurais tu une idée
merci
 

Dull

XLDnaute Barbatruc
Re : Aperçu avant imprim sur USF

Salut petchy, GCFRG, le Forum

essaye

Code:
Private Sub CmdImprimer_Click()
[COLOR=Red][B]Me.Hide[/B][/COLOR]
Application.ScreenUpdating = False
For I = 0 To LbFeuilles.ListCount - 1
If LbFeuilles.Selected(I) = True Then
Application.StatusBar = "Impression: " & LbFeuilles.List(I)
Application.DisplayAlerts = False
Sheets(LbFeuilles.List(I)).PrintPreview
Else
End If
Next I
Unload Me
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Bonne Journée
 

jeanpierre

Nous a quitté
Repose en paix
Re : Aperçu avant imprim sur USF

Bonsoir petchy, Dull (là bas au loin), GCFRG,

2 feuilles dans le même aperçu, je ne pense pas cela possible. Je ne pense pas, suis même sûr.

L'une après l'autre oui.

Bonnes Pâques.

Jean-Pierre
 

petchy

XLDnaute Occasionnel
Re : Aperçu avant imprim sur USF

Re
j'ai trouver se code qui fait un aperçu de plusieurs feuille,mais je n'arrive pas à l'appliquer sur l'usf
voila le code
Private Sub CommandButton3_Click()

Dim I As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Application.ScreenUpdating = False

' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Le classeur est protégé.", vbCritical
Exit Sub
End If

' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add

SheetCount = 0

' Add the checkboxes

TopPos = 40
For I = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(I)
' Skip empty sheets and hidden sheets
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next I

' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240

' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Selectionnez les feuilles à imprimer."

End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
Worksheets(cb.Caption).Select Replace:=False
End If
Next cb
' Pour imprimer :ActiveWindow.SelectedSheets.PrintOut copies:=1
ActiveWindow.SelectedSheets.PrintPreview
ActiveSheet.Select
End If
Else
MsgBox "Toutes les feuilles du classeur sont vides."
End If

' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete
Application.Dialogs(xlDialogPrint).Show
Sheets("Tarifs 1").Select
' Reactivate original sheet
'CurrentSheet.Activate
End Sub
 

Discussions similaires

Réponses
8
Affichages
535

Statistiques des forums

Discussions
312 509
Messages
2 089 144
Membres
104 050
dernier inscrit
Pepito93100