1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

[VBA] Gérer les impressions par VBA

Discussion dans 'Trucs et astuces' démarrée par MichelXld, 21 Février 2005.

  1. MichelXld

    MichelXld XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    3969
    "J'aime" reçus :
    22
    Page d'accueil :
    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('A1:D10').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/French/forum/messages/1_76835_76835.htm
    Le fichier zippé
    http://www.excel-downloads.com/html...fo=1,76930,8411/ImprimerSansCouleurDeFond.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/French/forum/messages/1_112487_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.xlDialogPrinterSetup).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/French/forum/messages/1_137747_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/French/forum/messages/1_125521_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
     
    alkacefa17 aime votre message.
  2. MichelXld

    MichelXld XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    3969
    "J'aime" reçus :
    22
    Page d'accueil :
    Re:Gérer les impressions par VBA

    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
     
  3. STephane

    STephane Guest

    Re:Gérer les impressions par VBA

    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
     
  4. MichelXld

    MichelXld Guest

    Re:Gérer les impressions par VBA

    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
     
  5. MichelXld

    MichelXld XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    3969
    "J'aime" reçus :
    22
    Page d'accueil :
    Re:Gérer les impressions par VBA

    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
    *******************************************

    Code (Text):
    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
    ****************************

    Code (Text):
    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
    [url]http://www.excel-downloads.com/html/French/forum/messages/1_125521_125521.htm[/url]

    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 [url]http://www.excel-downloads.com[/url]
    '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
    **************************************************

    Code (Text):
    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
    ***************************************

    Code (Text):
    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/French/phpwiki/index.php?pagename=MichelXld
    (cliquez une 2eme fois sur ce lien si un message d'erreur s'affiche)



    bonne journée
    MichelXld
     
  6. HELIUM

    HELIUM Guest

    Re:Gérer les impressions par VBA

    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)
     
  7. MichelXld

    MichelXld XLDnaute Barbatruc

    Inscrit depuis le :
    20 Février 2005
    Messages :
    3969
    "J'aime" reçus :
    22
    Page d'accueil :
    Re:Gérer les impressions par VBA

    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/components/com_simpleboard/uploaded/files/suiviImpression.zip



    Modifier la mise en page avant impression

    Code (Text):
    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)

    Code (Text):
    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

    Code (Text):
    ActiveSheet.PageSetup.PrintArea = '$A$1:$E$10'


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

    Code (Text):
    ActiveSheet.PageSetup.PrintArea = ''
    Une autre possibilité :

    Code (Text):
    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

    Code (Text):
    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 (Text):
    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
     
  8. goull

    goull Guest

    Re:Gérer les impressions par VBA

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

    PascalXLD Super Moderator

    Inscrit depuis le :
    21 Février 2005
    Messages :
    12454
    "J'aime" reçus :
    91
    Habite à:
    Rennes
    Page d'accueil :
    Utilise:
    Excel 2007 (PC)
    Re : Gérer les impressions par VBA

    Bonjour

    Je me suis permis de déplacer ce fil ancien dans la FAQ
     
  10. cathodique

    cathodique XLDnaute Accro

    Inscrit depuis le :
    3 Mars 2012
    Messages :
    1568
    "J'aime" reçus :
    75
    Sexe :
    Masculin
    Habite à:
    Montreuil
    Utilise:
    Excel 2010 (PC)
    Bonjour,:)

    Merci pour le partage, cependant pratiquement tous les liens de téléchargement des fichiers ne sont plus valides.

    Bon dimanche.;)
     

Partager cette page