Gérer les impressions par VBA

[MichelXld]

Bonsoir

Je profite du nouveau forum pour faire quelques tests d'utilisation des posts.
pour joindre l'utile à l'agréable vous trouverez ci dessous quelques exemples pour gérer les impressions par VBA , en espérant que cela puisse servir à quelqu'un .



Imprimer une feuille

Sub imprimerUneFeuille()
Sheets('Feuil1').printOut
End Sub



Imprimer une plage de cellules

Sub imprimerPlageCellules()
Sheets('feuil1').Range('A110').printOut
End Sub



Effectuer 3 éditions de la Feuil1

Sheets('Feuil1').PrintOut , , 3



Apercu de la Feuille nommée 'Feuil2' avant impression

Sub previsualiserAvantPrint()
Sheets('Feuil2').printPreview
End Sub



Imprimer la page active et les tous les classeurs liés

Sub imprimerPageActiveEtLiens()
Dim Lien As Hyperlink
Dim I As Byte
Application.screenUpdating = False
activeSheet.printOut
For Each Lien In activeSheet.Hyperlinks
Range(Lien.Range.Address).Hyperlinks(1).Follow newWindow:=False
For I = 1 To activeWorkbook.Sheets.Count
activeWorkbook.Sheets(I).printOut
Next I
activeWorkbook.Close
Next
Application.screenUpdating = True
End Sub



Imprimer une feuille sans couleur de fond
Le lien sur le forum XLD
http://www.excel-downloads.com/html/...6835_76835.htm
Le fichier zippé
http://www.excel-downloads.com/html/...leurDeFond.zip



Choix par inputBox du nombre de copies à imprimer

Sub imprimeClasseur()
Dim X As Byte
On Error goTo gestionErreur
X = inputBox('Saisir le nombre de copies à effectuer . ', 'Impression')
activeWorkbook.printOut Copies:=X, Collate:=True
Exit Sub
gestionErreur:
If Err = 13 Then msgBox 'Saisie non valide .'
End Sub



Imprimer une Feuille en noir et blanc

Sub impressionNoirEtBlanc()
With Worksheets('Feuil1')
.pageSetup.blackAndWhite = True 'parametrage N&B
.printOut 'imprimer
.pageSetup.blackAndWhite = False'réinitialisation
End With
End Sub



Changer temporairement l'imprimante active

Le lien sur le forum XLD
http://www.excel-downloads.com/html/...487_112487.htm



Afficher l'aperçu des sauts de page , de la feuille active

Sub afficherSautsDePage()
activeWindow.View = xlPageBreakPreview
End Sub



Masquer l'aperçu des sauts de page , de la feuille active

Sub masquerLesSautsDePage()
activeWindow.View = xlNormalView
End Sub



Afficher la boite de dialogue d'impression, en précisant le nombre de copies

Dans l'exemple le nombre de copies par défaut =3

Sub boiteDialogueImpression()
Application.Dialogs(xlDialogPrint).Show , , , 3
End Sub



Afficher la boite de dialogue pour le choix de l'imprimante

Sub boiteDialogueChoixImprimante()
Application.Dialogs(Excel.xlBuiltInDialog.xlDialog PrinterSetup).Show
End Sub



Empècher l'impression
Procedure evenementielle à placer dans 'ThisWorkbook'

Private Sub Workbook_beforePrint(Cancel As Boolean)
Cancel = True
End Sub



Signaler la fin d'impression par un msgBox

Le lien sur le forum XLD
http://www.excel-downloads.com/html/...747_137747.htm



Suivre l'impression des documents

La macro 'Suivi_Impression_V02' permet d'afficher dans la barre de statut des informations sur le document en cours d'édition :
le nombre de pages déja imprimées
le nombre total de pages à imprimer
le nom du document en cours d'impression
La macro 'Temporisation' permet de rafraichir régulierement les informations( toutes les 2 secondes dans l'exemple )
La macro 'Finir' termine la procedure lorsque la file d'attente d'impression est vide

voir la procedure du : 23-11-04 00:46 dans le fil de discussion
Le lien sur le forum XLD
http://www.excel-downloads.com/html/...521_125521.htm

Option Explicit
Public NbTotCle As Byte, NbImpCle As Byte, NbImp As Byte
Public FicCle As String

Sub Suivi_Impression_V02()
'La macro doit etre lancée après le déclenchement d'éditions !
'
'michelxld pour le forum http://www.excel-downloads.com
'le 22.11.2004 , testé avec WinXP et Excel2002
'necessite d'activer la reference Microsoft WMI Scripting Library
Dim nomPC As String, Fichier As String
Dim objWMIService As WbemScripting.SWbemServices
Dim colItems As WbemScripting.SWbemObjectSet
Dim objItem As WbemScripting.SWbemObject
Dim objPrintJobSet As Object
Dim NbTot As Byte, i As Byte
Dim Tableau()

nomPC = '.'

Set objWMIService = GetObject('winmgmts:\\\\' & nomPC & '\\root\\cimv2')
Set colItems = objWMIService.ExecQuery('Select * from Win32_PrintJob', , 48)
Set objPrintJobSet = objWMIService.InstancesOf('Win32_PrintJob')

ReDim Tableau(objPrintJobSet.Count, 3)
'remarque importante:
'sur mon poste , pour que objItem.PagesPrinted et objItem.TotalPages renvoient des valeurs
'cohérentes j'ai du installer les drivers spécifiques fournis avec l'imprimante
'et les utiliser à la place du driver de WindowsXP par defaut !
For Each objItem In colItems
Tableau(i, 0) = objItem.TotalPages 'nb de pages restant à imprimer
Tableau(i, 1) = objItem.PagesPrinted 'nb de pages imprimées
Tableau(i, 2) = objItem.document 'nom du document en cours d'impression
i = i + 1
Next

Fichier = Tableau(0, 2)
'
'permet de compter les pages pour l'edition de plusieurs onglets d'un document
'ou pour l'impression de plusieurs copies
For i = 0 To UBound(Tableau)
If Tableau(i, 2) = Fichier Then
NbTot = NbTot + Tableau(i, 0)
End If
Next i

If Fichier FicCle Then
FicCle = Fichier
NbTotCle = NbTot
NbImp = 0
NbImpCle = 0
Else
If NbImp Tableau(0, 1) Then NbImpCle = NbImpCle + 1

NbImp = Tableau(0, 1)
End If
'
Application.StatusBar = 'Nombre de pages imprimées : ' & NbImpCle & '/' & NbTotCle & ' ' & Fichier
'
If objPrintJobSet.Count = 0 Then
Application.StatusBar = 'Impression terminée'
Finir
Exit Sub
End If
,

Temporisation
End Sub

Sub Temporisation()
Application.OnTime Now + TimeValue('00:00:02'), 'Suivi_Impression_V02'
End Sub

Sub Finir()
On Error Resume Next
Application.OnTime Now + TimeValue('00:00:01'), 'Suivi_Impression_V02', , Schedule:=False
End Sub



Compter le nombre de documents dans la file d'attente d'impression

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

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



Lister les imprimantes installées et préciser laquelle est active

Sub listeImprimantes_et_Statut()
'testé avec Excel2002 et WinXP
Dim objWMIService As Object, colInstalledPrinters As Object, 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



Afficher les propriétés des imprimantes installées

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



Afficher les propriétés de zone d'impression d'une imprimante

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

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




bonne soirée
MichelXld

[MichelXld]

rebonsoir

apparament , s'il y a 2 antislash à la suite dans la procedure , ils n'aparaissent pas lors du collage dans le post :

les 3 macros utilisant les WMI_Class dans le premier message :

'Suivre l'impression des documents'
'Lister les imprimantes installées et préciser laquelle est active'
'Afficher les propriétés des imprimantes installées'

ne sont donc pas utilisables directement depuis ce fil de discussion


...dommage....


bonne soirée
MichelXld

bonjour Michel


ta macro 'Imprimer la page active et les tous les classeurs liés' devrait peut-être contrôler si le lien point effectivement sur un classeur (nouveau).



bonne journée
stéphane

bonjour STephane

merci pour ton message

tu as efectivement raison . je vais prendre en compte ta judicieuse remarque et je mettre à jour ma procedure


bon apres midi
MichelXld

[MichelXld]

bonjour

ci dessous

la macro 'Imprimer la page active et les tous les classeurs liés' modifiée suite aux remarques de STephane , ainsi que la reprise des 3 procedures qui ne fonctionnaient pas


Imprimer la page active et les tous les classeurs liés
*******************************************

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
Application.ScreenUpdating = True
End Sub

Suivre l'impression des documents
****************************

La macro 'Suivi_Impression_V02' permet d'afficher dans la barre de statut des informations sur le document en cours d'édition :
le nombre de pages déja imprimées
le nombre total de pages à imprimer
le nom du document en cours d'impression
La macro 'Temporisation' permet de rafraichir régulierement les informations( toutes les 2 secondes dans l'exemple )
La macro 'Finir' termine la procedure lorsque la file d'attente d'impression est vide 

voir la procedure du : 23-11-04 00:46 dans le fil de discussion
Le lien sur le forum XLD
http://www.excel-downloads.com/html/...521_125521.htm

Option Explicit
Public NbTotCle As Byte, NbImpCle As Byte, NbImp As Byte
Public FicCle As String

Sub Suivi_Impression_V02()
'La macro doit etre lancée après le déclenchement d'éditions !
'
'michelxld pour le forum http://www.excel-downloads.com
'le 22.11.2004 , testé avec WinXP et Excel2002
'necessite d'activer la reference Microsoft WMI Scripting Library
Dim nomPC As String, Fichier As String
Dim objWMIService As WbemScripting.SWbemServices
Dim colItems As WbemScripting.SWbemObjectSet
Dim objItem As WbemScripting.SWbemObject
Dim objPrintJobSet As Object
Dim NbTot As Byte, i As Byte
Dim Tableau()

nomPC = '.'

Set objWMIService = GetObject('winmgmts:\\\\' & nomPC & '\\root\\cimv2')
Set colItems = objWMIService.ExecQuery('Select * from Win32_PrintJob', , 48)
Set objPrintJobSet = objWMIService.InstancesOf('Win32_PrintJob')

ReDim Tableau(objPrintJobSet.Count, 3)
'remarque importante:
'sur mon poste , pour que objItem.PagesPrinted et objItem.TotalPages renvoient des valeurs
'cohérentes j'ai du installer les drivers spécifiques fournis avec l'imprimante
'et les utiliser à la place du driver de WindowsXP par defaut !
For Each objItem In colItems
Tableau(i, 0) = objItem.TotalPages 'nb de pages restant à imprimer
Tableau(i, 1) = objItem.PagesPrinted 'nb de pages imprimées
Tableau(i, 2) = objItem.document 'nom du document en cours d'impression
i = i + 1
Next

Fichier = Tableau(0, 2)
'
'permet de compter les pages pour l'edition de plusieurs onglets d'un document
'ou pour l'impression de plusieurs copies
For i = 0 To UBound(Tableau)
If Tableau(i, 2) = Fichier Then
NbTot = NbTot + Tableau(i, 0)
End If
Next i

If Fichier <> FicCle Then
FicCle = Fichier
NbTotCle = NbTot
NbImp = 0
NbImpCle = 0
Else
If NbImp <> Tableau(0, 1) Then NbImpCle = NbImpCle + 1

NbImp = Tableau(0, 1)
End If
'
Application.StatusBar = 'Nombre de pages imprimées : ' & NbImpCle & '/' & NbTotCle & ' ' & Fichier
'
If objPrintJobSet.Count = 0 Then
Application.StatusBar = 'Impression terminée'
Finir
Exit Sub
End If
,

Temporisation
End Sub

Sub Temporisation()
Application.OnTime Now + TimeValue('00:00:02'), 'Suivi_Impression_V02'
End Sub

Sub Finir()
On Error Resume Next
Application.OnTime Now + TimeValue('00:00:01'), 'Suivi_Impression_V02', , Schedule:=False
End Sub

Lister les imprimantes installées et préciser laquelle est active
**************************************************

Sub listeImprimantes_et_Statut()
'testé avec Excel2002 et WinXP
Dim objWMIService As Object, colInstalledPrinters As Object, 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

Afficher les propriétés des imprimantes installées
***************************************

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

toutes ces informations sont toujours accessibles et mises à jour sur les wikipages
http://www.excel-downloads.com/html/...name=MichelXld
(cliquez une 2eme fois sur ce lien si un message d'erreur s'affiche)



bonne journée
MichelXld

Bonjour,

J'ai lu avec intérêt, tous les pgm sur la gestion des imprimantes.
Y a t'il un moyen de savoir si l'imprimante que l'on sélectionne dans une liste est bien connectée ? On pourrait ainsi éviter d'envoyer une impression ou la stopper avant le message d'erreur.
Merci d'avance

A+
HEL
(cf message 17/03 : CONNEXION IMPRIMANTE)

[MichelXld]

bonjour

ci joint quelques macros supplémentaires



Un nouvel exemple pour suivre l'impression des documents (WinXP)

Le fichier zippé
http://www.excel-downloads.com/compo...Impression.zip



Modifier la mise en page avant impression

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.PrintPreview
End Sub

Arreter l'impression en cours et vider la file d'attente (WinXP)

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

Définir la zone d'impression sur une plage de cellules

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

Réinitialiser la zone d'impression à la feuille complete

ActiveSheet.PageSetup.PrintArea = ''

Une autre possibilité :

ActiveSheet.PageSetup.PrintArea = False

Vérifier si l'imprimante est parametree pour imprimer en Noir et Blanc ou en couleur
(WinXP)

si tu connais le nom de l'imprimante

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)

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

bon week end
MichelXld


ps
désolé Helium , mais je n'ai pas de réponse à ta question

Bonjour,
je cherche à imprimer en recto verso mais je n'arrive pas à mettre la main sur la commande
merci d'avance