Discussion :

[SilkyRoad]

Q. Comment imprimer une feuille spécifique plusieurs fois ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'La macro va effectuer 3 éditions de la Feuil2
Sheets("Feuil2").PrintOut , , 3

---------


Q. Comment définir la zone d'impression sur une plage de cellules ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.PageSetup.PrintArea = "$A$1:$E$10"

Pout réinitialiser la zone d'impression à la feuille complète:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.PageSetup.PrintArea = ""

Une autre possibilité:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.PageSetup.PrintArea = False

---------


Q. Comment adapter la zone d'impression à une seule page ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
With ActiveSheet.PageSetup
    .PrintArea = "A1:M100"
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With

---------


Q. Comment imprimer toutes les feuilles du classeur ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim Ws As Worksheet
 
For Each Ws In ThisWorkbook.Worksheets
    Ws.PrintOut
Next

-------


Q. Comment imprimer une plage de cellules ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuil1").Range("A1:D10").PrintOut

-------


Q. Comment modifier la mise en page avant impression ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub miseEnPageAvantImpression()
    With Feuil1.PageSetup
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1.5)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
    End With
 
    Feuil1.PrintOut
End Sub

-------


Q. Comment afficher l'aperçu avant impression ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuil2").PrintPreview

Vous pouvez aussi afficher l'aperçu avant impression en utilisant les boites de dialogues intégrées d'Excel:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Dialogs(xlDialogPrintPreview).Show

Remarque :
L'argument False permet de rendre inactifs les boutons "mise en page" et "Marges"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Dialogs(xlDialogPrintPreview).Show False

--------


Q. Comment imprimer la page active et les tous les classeurs liés ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub imprimerPageActiveEt_LiensClasseurs()
Dim Lien As Hyperlink
Dim I As Byte
 
Application.ScreenUpdating = False
 
ActiveSheet.PrintOut
For Each Lien In ActiveSheet.Hyperlinks
    If Right(Range(Lien.Range.Address).Hyperlinks(1).Address, 4) = ".xls" Then
        Range(Lien.Range.Address).Hyperlinks(1).Follow NewWindow:=False
 
        For I = 1 To ActiveWorkbook.Sheets.Count
            ActiveWorkbook.Sheets(I).PrintOut
        Next I
 
        ActiveWorkbook.Close
    End If
Next Lien
 
Application.ScreenUpdating = True
End Sub

--------



Q. Comment imprimer une Feuille en noir et blanc ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub impressionNoirEtBlanc()
    With Worksheets("Feuil1")
        .PageSetup.BlackAndWhite = True 'parametrage N&B
        .PrintOut 'imprimer
        .PageSetup.BlackAndWhite = False 'réinitialisation
    End With
End Sub

-------------


Q. Comment afficher la boîte de dialogue pour le choix de l'imprimante

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Application.Dialogs(xlDialogPrinterSetup).Show = True Then Feuil1.PrintOut

-----------


Q. Comment Empêcher l'impression dans un classeur ?

Utilisez l'évènement Workbook_BeforePrint.
Cet évènement survient avant l'impression. L'impression commence uniquement à l'issue de cette procédure.
Le paramètre Cancel = True bloque toute impression

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Cancel = True
End Sub

-----------


Q. Comment compter le nombre de documents dans la file d'attente d'impression ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
 
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" _
(ByVal pPrinterName As String, phPrinter As Long, pDefault As Any) As Long
 
Private Declare Function ClosePrinter Lib "winspool.drv" _
    (ByVal hPrinter As Long) As Long
 
Private Declare Function EnumJobs Lib "winspool.drv" Alias "EnumJobsA" _
(ByVal hPrinter As Long, ByVal FirstJob As Long, ByVal NoJobs As Long, _
ByVal Level As Long, pJob As Any, ByVal cdBuf As Long, pcbNeeded As Long, _
pcReturned As Long) As Long
 
 
Sub fichiersFileAttenteImpression()
'source: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Dim hPrinter As Long, lNeeded As Long, lReturned As Long
Dim lJobCount As Long
 
'Adaptez le nom de l'imprimante
OpenPrinter "hp deskjet 940c series", hPrinter, ByVal 0&
EnumJobs hPrinter, 0, 99, 1, ByVal 0&, 0, lNeeded, lReturned
 
If lNeeded > 0 Then
    ReDim byteJobsBuffer(lNeeded - 1) As Byte
    EnumJobs hPrinter, 0, 99, 1, byteJobsBuffer(0), lNeeded, lNeeded, lReturned
 
    If lReturned > 0 Then
        lJobCount = lReturned
        Else
        lJobCount = 0
    End If
 
    Else
 
    lJobCount = 0
End If
 
ClosePrinter hPrinter
MsgBox "nombre de documents dans la file d'attente: " + _
    CStr(lJobCount), vbInformation
End Sub

---------


Q. Comment lister les imprimantes installées et préciser laquelle est active ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub listeImprimantes_et_Statut()
'testé avec Excel2002 et WinXP
Dim objWMIService As Object, colInstalledPrinters As Object
Dim objPrinter As Object
Dim nomPC As String, Resultat As String
 
nomPC = "."
 
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & nomPC & "\root\cimv2")
Set colInstalledPrinters = _
    objWMIService.execQuery("Select * from Win32_Printer")
 
For Each objPrinter In colInstalledPrinters
    Resultat = Resultat & objPrinter.Name & " imprimante active : " _
    & objPrinter.Default & vbLf
Next
 
MsgBox Resultat
End Sub

---------



Q. Comment afficher les propriétés des imprimantes installées ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub proprietesImprimantes()
Dim objWMIService As Object, colItems As Object
Dim objItem As Object
Dim strComputer As String
Dim i As Byte
 
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = _
    objWMIService.ExecQuery("Select * from Win32_PrinterConfiguration", , 48)
 
For Each objItem In colItems
    i = i + 1
    Cells(1, i) = "BitsPerPel: " & objItem.BitsPerPel
    Cells(2, i) = "Caption: " & objItem.Caption
    Cells(3, i) = "Collate: " & objItem.Collate
    Cells(4, i) = "Color: " & objItem.Color
    Cells(5, i) = "Copies: " & objItem.Copies
    Cells(6, i) = "Description: " & objItem.Description
    Cells(7, i) = "DeviceName: " & objItem.DeviceName
    Cells(8, i) = "DisplayFlags: " & objItem.DisplayFlags
    Cells(9, i) = "DisplayFrequency: " & objItem.DisplayFrequency
    Cells(10, i) = "DitherType: " & objItem.DitherType
    Cells(11, i) = "DriverVersion: " & objItem.DriverVersion
    Cells(12, i) = "Duplex: " & objItem.Duplex
    Cells(13, i) = "FormName: " & objItem.FormName
    Cells(14, i) = "HorizontalResolution: " & objItem.HorizontalResolution
    Cells(15, i) = "ICMIntent: " & objItem.ICMIntent
    Cells(16, i) = "ICMMethod: " & objItem.ICMMethod
    Cells(17, i) = "LogPixels: " & objItem.LogPixels
    Cells(18, i) = "MediaType: " & objItem.MediaType
    Cells(19, i) = "Name: " & objItem.Name
    Cells(20, i) = "Orientation: " & objItem.Orientation
    Cells(21, i) = "PaperLength: " & objItem.PaperLength
    Cells(22, i) = "PaperSize: " & objItem.PaperSize
    Cells(23, i) = "PaperWidth: " & objItem.PaperWidth
    Cells(24, i) = "PelsHeight: " & objItem.PelsHeight
    Cells(25, i) = "PelsWidth: " & objItem.PelsWidth
    Cells(26, i) = "PrintQuality: " & objItem.PrintQuality
    Cells(27, i) = "Scale: " & objItem.Scale
    Cells(28, i) = "SettingID: " & objItem.SettingID
    Cells(29, i) = "SpecificationVersion: " & objItem.SpecificationVersion
    Cells(30, i) = "TTOption: " & objItem.TTOption
    Cells(31, i) = "VerticalResolution: " & objItem.VerticalResolution
    Cells(32, i) = "XResolution: " & objItem.XResolution
    Cells(33, i) = "YResolution: " & objItem.YResolution
 
    Columns(i).AutoFit
Next
End Sub

-----------



Q. Comment afficher les propriétés de la zone d'impression d'une imprimante ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
(ByVal lpDriverName As String, ByVal lpDeviceName As String, _
ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
 
Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
 
Const HORZRES = 8
Const VERTRES = 10
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Const PHYSICALWIDTH = 110
Const PHYSICALHEIGHT = 111
Const PHYSICALOFFSETX = 112
Const PHYSICALOFFSETY = 113
 
Sub ProprietesZoneImpressionImprimante()
'source http://support.microsoft.com/?id=193943
Dim dpiX As Long, dpiY As Long
Dim MarginLeft As Long, MarginRight As Long
Dim MarginTop As Long, MarginBottom As Long
Dim PrintAreaHorz As Long, PrintAreaVert As Long
Dim PhysHeight As Long, PhysWidth As Long
Dim Info As String, Cible As String
Dim HwndPrint As Long
Dim Lret As Long
 
'Adaptez le nom de l'imprimante
Cible = "hp deskjet 940c series"
HwndPrint = CreateDC(0, Cible, 0, 0)
 
dpiX = GetDeviceCaps(HwndPrint, LOGPIXELSX)
Info = "Pixels X: " & dpiX & " dpi"
 
dpiY = GetDeviceCaps(HwndPrint, LOGPIXELSY)
Info = Info & vbCrLf & "Pixels Y: " & dpiY & " dpi"
 
MarginLeft = GetDeviceCaps(HwndPrint, PHYSICALOFFSETX)
Info = Info & vbCrLf & "Unprintable space on left: " & _
MarginLeft & " pixels (" & Format(MarginLeft / dpiX, "0.000") & " inches)"
 
MarginTop = GetDeviceCaps(HwndPrint, PHYSICALOFFSETY)
Info = Info & vbCrLf & "Unprintable space on top: " & _
MarginTop & " pixels (" & Format(MarginTop / dpiY, "0.000") & " inches)"
 
PrintAreaHorz = GetDeviceCaps(HwndPrint, HORZRES)
Info = Info & vbCrLf & "Printable space (Horizontal): " & _
PrintAreaHorz & " pixels (" & Format(PrintAreaHorz / dpiX, "0.000") & " inches)"
 
PrintAreaVert = GetDeviceCaps(HwndPrint, VERTRES)
Info = Info & vbCrLf & "Printable space (Vertical): " & _
PrintAreaVert & " pixels (" & Format(PrintAreaVert / dpiY, "0.000") & " inches)"
 
PhysWidth = GetDeviceCaps(HwndPrint, PHYSICALWIDTH)
Info = Info & vbCrLf & "Total space (Horizontal): " & _
PhysWidth & " pixels (" & Format(PhysWidth / dpiX, "0.000") & " inches)"
 
MarginRight = PhysWidth - PrintAreaHorz - MarginLeft
Info = Info & vbCrLf & "Unprintable space on right: " & _
MarginRight & " pixels (" & Format(MarginRight / dpiX, "0.000") & " inches)"
 
PhysHeight = GetDeviceCaps(HwndPrint, PHYSICALHEIGHT)
Info = Info & vbCrLf & "Total space (Vertical): " & _
PhysHeight & " pixels (" & Format(PhysHeight / dpiY, "0.000") & " inches)"
 
MarginBottom = PhysHeight - PrintAreaVert - MarginTop
Info = Info & vbCrLf & "Unprintable space on bottom: " & _
MarginBottom & " pixels (" & Format(MarginBottom / dpiY, "0.000") & " inches)"
 
MsgBox Info, , "Information"
End Sub

---------


Q. Comment Arrêter l'impression en cours et vider la file d'attente ?

(WinXP)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub interrompreImpression_WinXP()
Dim strComputer As String
Dim objWMIService As Object, colInstalledPrinters As Object
Dim objPrinter As Object
 
strComputer = "."
Set objWMIService = _
    GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = _
    objWMIService.ExecQuery("Select * from Win32_Printer")
 
For Each objPrinter In colInstalledPrinters
    objPrinter.CancelAllJobs
Next
 
Set objWMIService = Nothing
Set colInstalledPrinters = Nothing
End Sub

--------


Q. Comment vérifier si l'imprimante est paramétrée pour imprimer en Noir et Blanc ou en couleur ?


si vous connaissez le nom de l'imprimante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub verifier_parametre_Couleur_NB_Imprimante_V01()
Dim objWMIService As Object, colItems As Object
Dim objItem As Object
Dim strComputer As String
 
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = _
    objWMIService.ExecQuery("Select * from Win32_PrinterConfiguration " & _
    "where Name = 'hp deskjet 940c series'")
 
For Each objItem In colItems
    Select Case objItem.Color
    Case 1: MsgBox objItem.Name & " : noir et blanc"
    Case 2: MsgBox objItem.Name & " : couleur"
    End Select
Next
End Sub

En bouclant sur toutes les imprimantes du poste (en local)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub verifier_parametre_Couleur_NB_Imprimante_V02()
Dim objWMIService As Object, colItems As Object
Dim objItem As Object
Dim strComputer As String
 
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = _
objWMIService.ExecQuery("Select * from Win32_PrinterConfiguration", , 48)
 
For Each objItem In colItems
    Select Case objItem.Color
    Case 1: MsgBox objItem.Name & " : noir et blanc"
    Case 2: MsgBox objItem.Name & " : couleur"
    End Select
Next
End Sub

---------


Q. Comment Répéter l'insertion des premières lignes, pour toutes les pages imprimées dans un même onglet?


Menu Fichier
Mise en page
Onglet "Feuille"
dans le champ "Lignes à répéter en haut", sélectionnez les lignes qui devront apparaître sur chaque page imprimée.


---------


Q.Comment centrer le contenu de la feuille lors de l'impression ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
With Feuil1
    .PageSetup.CenterHorizontally = True
    .PageSetup.CenterVertically = True
    .PrintOut
End With

---------


Q. Comment imprimer un fichier texte ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Shell "notepad.exe /P""C:\monRepertoire\leFichier.txt""", 1

---------


Q. Comment ouvrir le port d'impression pour éditer un texte ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub imprimerTexte()
    Open "LPT1:" For Output As #1
    Print #1, "test d'impression."
    Print #1, "test 2eme ligne."
    Close #1
End Sub

--------


Q. Comment imprimer le 2eme objet graphique contenu dans le Feuil1 ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Feuil1.ChartObjects(2).Chart.PrintOut

-----------


Q. Comment imprimer la Feuil1 d'un Addin (.xla) ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
With Workbooks("test.xla")
    .IsAddin = False
    .Worksheets("Feuil1").PrintOut Copies:=1, Collate:=True
    .IsAddin = True
End With

---------


Q. Comment imprimer la première page en mode Paysage et la deuxième page en mode Portrait ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
With Feuil1
    .PageSetup.Orientation = xlLandscape
    .PrintOut From:=1, To:=1
    .PageSetup.Orientation = xlPortrait
    .PrintOut From:=2, To:=2
End With