Imprimer

Bonsoir à Tous

Voici mon problème

J'ai un classeur d'environ 40 onglets. Ces derniers sont en principe d'une
page (d'impression).

J'ai réalisé avec un copain une macro pour faire un genre de sommaire.
L'objectif est d'imprimer les onglets dont j'ai besoin sachant que certains
sont d'une page et d'autres plus (maxi 3).
J'ai donc fait une macro qui, par double clic inscrit un caractère en
colonne A.
Je veux maintenant imprimer les pages qui sont dans le sommaire précédées en
colonne A dudit caractère.

Je vous joint ci-après mes macros, merci de vos observations et me dire
pourquoi ça ne fonctionne pas...

PS, j'ai toujours la feuille du sommaire qui se visualise (avant impression)
est-ce normal?
Et la message box de chaque onglet sélectionné que je voudrais virer...
Encore merci de vos lumières

DV

Voici mes codes

Sub ListeFichiers()
Dim LIG As Integer
Dim FICHIERSXLS As String
Columns("A:A").Select ' Sélection Colonne A
Selection.ClearContents ' Suppression contenu Colonne A
Range("A1").Select ' Sélection Cellule A1
LIG = 1 ' Initialmisation Vble LIG = 1
FICHIERSXLS = Dir("*.xls")
Do Until FICHIERSXLS = "" ' Boucle Jusqu'à ce que FICHIERSXLS = ""
Cells(LIG, 1) = FICHIERSXLS
LIG = LIG + 1 ' Incrémentation de Vble LIG
FICHIERSXLS = Dir
Loop
End Sub
--------------------------------------------------------------------
Sub ListeOnglets()
Dim LIG As Integer
Dim ONGLET As String
Dim F As Worksheet
Worksheets("Impression").Select
'------------------- Liste des Feuilles
Columns("A:B").Select ' Sélection Colonne A et B
Selection.ClearContents ' Suppression contenu Colonne A
Range("B1").Value = "Liste des Feuilles"
Columns("A:B").EntireColumn.Select
Selection.Columns.AutoFit
Range("B2").Select ' Sélection Cellule B2
LIG = 2 ' Initialisation Vble LIG = 1
For Each F In Worksheets
If F.Name <> "Impression" Then
ONGLET = F.Name
Cells(LIG, 2) = ONGLET
LIG = LIG + 1 ' Incrémentation de Vble LIG
End If
Next
'------------------- Tri Alpha des Feuilles
'Range("A1").Select
'Selection.CurrentRegion.Select
'Selection.Sort Key1:=ActiveCell.Offset(0, 1).Range("A1"), Order1:= _
'xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
'Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("A1").Select
End Sub
-----------------------------------------------------------------------------------
Sub ImprimOnglets()
Dim NF As String
Dim K As Integer
Range("B3").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, -1).Range("A3").Select
Selection.End(xlUp).Select
K = Selection.Row ' Dernière Ligne sélectionnée
'--------------------------------- Boucle Impression
Range("A3").Select ' Sélection Cellule A3
If K > 1 Then
Do While K > 1
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "þ" Then
GoSub IMPRESSION
End If
K = K - 1
Loop
Else
MsgBox "Pas de Sélection"
End If
GoTo FIN
'----------------------------------
IMPRESSION:
NF = ActiveCell.Offset(0, 1).Value
MsgBox "Feuille " & NF

ActiveWindow.SelectedSheets.PrintPreview

Return
'-----------------------------------
FIN:

End Sub
-----------------------------------------------------------------------------------------
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
If Not (Intersect(Target, Range("A2:A500")) Is Nothing) Then
Cancel = True
Target.Font.Name = "Wingdings"
Target.HorizontalAlignment = xlCenter
If Target.Value = "" Then
Target.Value = "þ"
Else
Target.Value = ""
End If
End If
End Sub