' Verweis auf Microsoft Excel xx.x Object Library nicht vergessen.
 
Private Sub Command1_Click()
Dim objExcelApp As Excel.Application
Dim objWorkbooks As Excel.Workbooks
Dim objSheet As Excel.Worksheet
Dim Seite As Integer
Dim Kopie As Integer
 
On Error GoTo Fehler
 
    Set objExcelApp = CreateObject("Excel.Application")
    Set objWorkbooks = objExcelApp.Workbooks
    objWorkbooks.Open ("C:\Test\Versuch.xls")
 
    With CommonDialog1
      .CancelError = True
      .PrinterDefault = True
      .Flags = cdlPDPageNums Or cdlPDNoSelection
      .Min = 1
      .Max = objWorkbooks.Item(1).Worksheets.Count
      .FromPage = 1
      .ToPage = objWorkbooks.Item(1).Worksheets.Count
      .ShowPrinter
      For Seite = .FromPage To .ToPage
        Set objSheet = objWorkbooks.Item(1).Worksheets(Seite)
        For Kopie = 1 To .Copies
          objSheet.PrintOut
        Next
      Next
    End With
 
    objWorkbooks.Item(1).Close
    Set objWorkbooks = Nothing
 
    Exit Sub
 
Fehler:
  If Err.Number <> 32755 Then
    MsgBox Err.Description
  End If
 
  objWorkbooks.Item(1).Close
  Set objWorkbooks = Nothing
  Exit Sub
 
End Sub