aide sur programme vb impression

Dernière réponse : 9 Janvier 2006 15:24 dans Programmation

janickgandin

9 Janvier 2006 14:00:38

Bonjour,
Ci-joint mes deux programmes d'impression pour le quel je souhaiterais avoir dans le deuxieme le choix d'ecrire les pages et la zone d'impression de mon choix
merci de votre aide

Sub Imprim1()
Msg = "Voulez-vous vraiment imprimer TOUTES les fiches ?"
Style = vbYesNo + vbQuestion + vbDefaultButton2
Title = "IMPRESSION DES FICHES 1er Trimestre"
Réponse = MsgBox(Msg, Style, Title)
If Réponse = vbYes Then
GoTo continu
Else
Exit Sub
End If
continu:
Dim mafeuille As Object
Application.ScreenUpdating = False
Set monTab = Worksheets(Array("5", "6", "7", "8")) '< Changer ici le nom des pages à imprimer
For Each mafeuille In monTab
mafeuille.Select
ActiveSheet.PageSetup.PrintArea = "$A$2:$B$20" '< Changer ici la plage à imprimer
ActiveWindow.SelectedSheets.PrintOut Copies:=1 '< Changer ici le nombre d'impression
Next
End Sub

Option Explicit
Dim I As Integer, n As Integer, S As Integer
Dim FeuilleActuel As String
Dim MySheet As Worksheet

Private Sub CmdFermer_Click()
Unload Me
End Sub

Sub MarqueDocumentsListbox()
Dim OpenWorkbook As Workbook
For Each OpenWorkbook In Application.Workbooks
If OpenWorkbook.IsAddin Then
Else
If OpenWorkbook.Name = "Perso.xls" Then
Else
LbClasseurs.AddItem (OpenWorkbook.Name)
End If
End If
Next OpenWorkbook
End Sub

Private Sub CmdImprimer_Click()
Application.ScreenUpdating = False
For I = 0 To LbFeuilles.ListCount - 1
If LbFeuilles.Selected(I) = True Then
'ActiveWindow.SelectedSheets.PrintPreview
Application.StatusBar = "Impression: " & LbFeuilles.List(I)
Application.DisplayAlerts = False
Sheets(LbFeuilles.List(I)).PrintOut
Else
End If
Next I
'Application.DisplayAlerts = True
Unload Me
Application.StatusBar = False
Application.ScreenUpdating = True
'Cmdfermer.
End Sub

Private Sub CmdSelectionImprimante_Click()

Application.Dialogs(xlDialogPrinterSetup).Show
End Sub

Private Sub CmdSupprimer_Click()
Dim Msg, Style, Title, Response
Unload Me 'FrmImprime
For I = 0 To LbFeuilles.ListCount - 1
If LbFeuilles.Selected(I) = True Then
With ActiveWorkbook.Sheets(LbFeuilles.List(I))
'Faites quelque chose
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "Impression de Feuilles de calcul "
Msg = " Supprimez Feuille " & (LbFeuilles.List(I)) & " ? " & " "
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then GoTo next0
If Worksheets(LbFeuilles.List(I)).Visible = False Then
MsgBox " Feuille Cachée ", vbInformation, "Impression de Feuilles de calcul"
Worksheets(LbFeuilles.List(I)).Visible = True
Application.DisplayAlerts = False
Worksheets(LbFeuilles.List(I)).Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Else
Application.DisplayAlerts = False
Worksheets(LbFeuilles.List(I)).Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End If
next0:
End With
'La fin fait quelque chose
End If
Next
Application.ScreenUpdating = True
End Sub

'Teste
'Sub NbrsFeuilles()
'Dim ws As Worksheet
'FrmImprime.LbFeuilles.Clear
'With FrmImprime
'.LblNombreFeuilles.Caption = "Nbrs de Feuilles: " & n
'End With
'For Each ws In Worksheets
'FrmImprime.LbFeuilles.AddItem ws.Name
'Next ws
'FrmImprime.Show
'End Sub

Private Sub CmdWsToutesSelection_Click()
For I = 0 To LbFeuilles.ListCount - 1
LbFeuilles.Selected(I) = True
Next I
End Sub

Private Sub CmdWsInverseSelection_Click()
For I = 0 To LbFeuilles.ListCount - 1
If LbFeuilles.Selected(I) = False Then
LbFeuilles.Selected(I) = True
Else
LbFeuilles.Selected(I) = False
End If
Next I
End Sub

Private Sub CmdWsAucuneSelection_Click()
For I = 0 To LbFeuilles.ListCount - 1
LbFeuilles.Selected(I) = False
Next I
End Sub

Private Sub LbFeuilles_Change()
Application.ScreenUpdating = False
n = 0
For S = 0 To LbFeuilles.ListCount - 1
If LbFeuilles.Selected(S) = True Then n = n + 1
Next S
LblNombreFeuilles.Caption = "Nbrs de Feuilles: " & n
End Sub

Private Sub LbClasseurs_Change()
On Error Resume Next
FeuilleActuel = ActiveSheet.Name
Workbooks(LbClasseurs.Value).Activate
Call MarqueListeSheet
Call MarqueFeuillesListbox
LbFeuilles.Value = FeuilleActuel
End Sub

Sub MarqueListeSheet()
On Error Resume Next
Dim I As Integer
I = 1
For I = 1 To LbFeuilles.ListCount + 1
LbFeuilles.RemoveItem (LbFeuilles.ListIndex = I)
Next I
On Error GoTo 0
End Sub

Sub MarqueFeuillesListbox()
Dim AvailableSheet As Worksheet
For Each AvailableSheet In ActiveWorkbook.Worksheets
If AvailableSheet.Visible = xlSheetVisible Then
LbFeuilles.AddItem (AvailableSheet.Name)
Else
End If
Next AvailableSheet
On Error GoTo 0
End Sub

Private Sub UserForm_Initialize()
Call MarqueDocumentsListbox
Application.EnableEvents = False
LbClasseurs.Value = ActiveWorkbook.Name
Application.EnableEvents = True
End Sub

Autres pages sur : aide programme impression

| Etre averti des réponses
| Alerter

Répondre à janickgandin

Lassé par la pub ? Créez un compte

zeb

Expert Programmation

9 Janvier 2006 15:24:30

C'est gentil de dire bonjour et merci c'est essentiel. Mais la politesse sur un forum c'est aussi d'en respecter les règles. Ici sur PPC, on est prié de mettre le code entre les balises [ CODE ] et [/ CODE ]. Ensuite ne pas balancer TOUS ton programme. Surtout quand tu dis

Citation :

je souhaiterais avoir dans le deuxieme le choix

Ben elle est où la séparation entre 1 et 2 ? Et puis je veux bien répondre à une question même difficile (tenter de répondre :sarcastic:

), mais lire 200 lignes de code pour comprendre ce que tu veux est plutôt fastidieux. Nettoye un peu ça en cliquant sur

et puisque j'ai pris le temps de te faire la morale, je (ou un autre) prendrai sûrement le temps de te répondre...

| Alerter

Répondre à zeb

Lassé par la pub ? Créez un compte

Créer un nouveau sujet

Contenus similaires :

Tags :