Imprimer recto verso

Le
David Vincent
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) en recto verso.
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:¬tiveCell.Offset(0, 1).Range("A1"), Order1:= _
'xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:úlse, _
'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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
francois.forcet
Le #5225341
Salut à toi
Pour enlever le message box de chaque onglet sélectionné
Supprimes les lignes :

NF = ActiveCell.Offset(0, 1).Value
MsgBox "Feuille " & NF

Changes la ligne :

ActiveWindow.SelectedSheets.PrintPreview

Par la ligne :

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

dans Sub ImprimOnglets()

Je changerai la partie :

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

Par :

K = Range("A65535").End(xlUp).Row

Pour un résultat équivalent

Je pense que celà devrait te convenir

Dis moi !!!!
David Vincent
Le #5224601
Bonjour François,
je regarderai que demain et te dirai

Merci

DV
Publicité
Poster une réponse
Anonyme