ThisWorkbook.PrintOut

'spécifiez l'argument "Copies" pour définir le nombre de copies (3 dans cet exemple).
ActiveWorkbook.PrintOut Copies:=3, Collate:=True

Worksheets("Feuil2").PrintOut

Worksheets("Feuil1").Range("A1:D10").printOut

Worksheets("Feuil2").PrintPreview

Application.Dialogs(xlDialogPrintPreview).Show

Application.Dialogs(xlDialogPrintPreview).Show False

Sub imprimerPageActiveEt_Liensclasseurs()
Dim Lien As Hyperlink
Dim I As Byte

Application.ScreenUpdating = False
'Imprime la feuille active
ActiveSheet.PrintOut

'Boucle sur les liens de la feuille active
For Each Lien In ActiveSheet.Hyperlinks
    'Vérifie si le lien correspond à un classeur
    If Right(Range(Lien.Range.Address).Hyperlinks(1).Address, 4) = ".xls" Then
        'Déclenche le lien pour ouvrir le classeur
        Range(Lien.Range.Address).Hyperlinks(1).Follow NewWindow:=False
        
        'Imprime le classeur
        ActiveWorkbook.PrintOut
        
        'Referme le classeur
        ActiveWorkbook.Close
    End If
Next

Application.ScreenUpdating = True
End Sub

Sub impressionNoirEtBlanc()
    With Worksheets("Feuil1")
        .PageSetup.BlackAndWhite = True 'paramétrage N&B
        .PrintOut 'imprime
        .PageSetup.BlackAndWhite = False 'réinitialisation
    End With
End Sub

Application.Dialogs(xlDialogPrint).Show , , , 3

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

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

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

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

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

Option Explicit

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
    
    
    '--- Attention à bien indiquer le nom de l'imprimante avant de lancer la macro ---
    '
    Cible = "hp deskjet 940c" 'Nom de l'imprimante
    '
    '
    
    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

Sub miseEnPageAvantImpression()
    With Feuil1.PageSetup
        'Définit la zone d'impression pour une plage de cellules.
        .PrintArea = "$A$1:$E$10"
        'Mise en page: définit les marges
        .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

With Feuil1.PageSetup
    .PrintArea = "A1:M100"
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With

Feuil1.PageSetup.PrintArea = ""

Feuil1.PageSetup.PrintArea = False

With Feuil1
    .PageSetup.CenterHorizontally = True
    .PageSetup.CenterVertically = True
    .PrintOut
End With

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

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

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

Private Sub CommandButton1_Click()
    Me.PrintForm
End Sub

Option Explicit

Private Declare Sub keybd_event Lib "user32" ( _
        ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _
        ByVal dwExtraInfo As Long)

Private Sub CommandButton1_Click()
    Dim Ws As Worksheet
    
    'Copie d'écran de la forme active
    keybd_event vbKeySnapshot, 1, 0&, 0&
    DoEvents
    
    'Ajoute une feuille pour coller l'image de la forme
    Set Ws = Sheets.Add
    Ws.Paste
    
    'impression centrée dans la page
    With Ws
        .PageSetup.CenterHorizontally = True
        .PageSetup.CenterVertically = True
        .PrintOut
    End With
End Sub

Private Sub CommandButton1_Click()
    Me.Hide
    'Aperçu avant impression de la Feuil1
    Feuil1.PrintPreview
    Me.Show
End Sub

'Imprime une sélection de feuilles ("Feuil1" et "Feuil3")
Worksheets(Array("Feuil1", "Feuil3")).PrintOut

With objFeuille.PageSetup
    .CenterFooter = "&P"
    .CenterHeader = "&F"
    .FirstPageNumber = 3
    .FitToPagesWide = 1
    .Orientation = xlLandscape
    .PrintGridlines = False
    .PrintHeadings = False
End With
objFeuille.PrintOut 1, 1, 1, False

Option Explicit
Option Base 1
 
 
Sub Test()
    'Worksheets(1) définit la premiere feuille du classeur, à imprimer.
    'Range("C4:F15")définit la plage de cellules à masquer
    MasqueContenuCell_Print Worksheets(1), Range("C4:F15")
End Sub
 
 
Sub MasqueContenuCell_Print(Feuille As Worksheet, Plage As Range)
    Dim FormatInit() As Variant
    Dim Cell As Range
    Dim i As Integer
    
    'Redimesionne le tableau qui va stocker les formats initiaux
    ReDim Preserve FormatInit(Plage.Cells.Count)
    
    'Boucle sur la plage de cellules
    For Each Cell In Plage
        i = i + 1
        FormatInit(i) = Cell.NumberFormat
    Next Cell
    
    'Applique le format ;;; pour masquer le contenu des cellules.
    Plage.NumberFormat = ";;;"
    'Feuille.PrintPreview
    Feuille.PrintOut
    
    i = 0
    'Boucle sur la plage de cellules pour réattibuer les formats initiaux
    For Each Cell In Plage
        i = i + 1
        Cell.NumberFormat = FormatInit(i)
    Next Cell
End Sub

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String _
    , ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Sub ImprimerFichier()
    Dim NomFichier As String
    Dim x As Long
    
    x = FindWindow("XLMAIN", Application.Caption)
    NomFichier = "C:\dossier\rapport.pdf"
    
    ShellExecute x, "print", NomFichier, "", "", 1
End Sub

MsgBox ExecuteExcel4Macro("GET.DOCUMENT(50)")

With Feuil1
    .PageSetup.CenterFooter = "Pied de page 1"
    .PrintOut From:=1, To:=1 ', preview:=True
    
    .PageSetup.CenterFooter = "Pieds de Pages suivants"
    .PrintOut From:=2, To:=ExecuteExcel4Macro("GET.DOCUMENT(50)") ', preview:=True
End With