drucken

habe rechner mit xp und w2k im netzwerk, zwei drucker eingerichtet (1 gerät) für blankopapier und briefbogen
folgender code funktioniert nur unter w2k, die excel-versionen sind auf allen rechnern die gleichen
On Error Resume Next
Application.ActivePrinter = "\\server\Blankopapier auf Ne01:"
Application.ActivePrinter = "Blankopapier auf LPT1:"
ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
On Error Resume Next
Application.ActivePrinter = "\\Tony\Briefbogen auf Ne02:"
Application.ActivePrinter = "Briefbogen auf LPT1:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
was ist das problem und löse ich es?
das mit den sendkeys habe ich probiert...komme aber nicht klar damit
danke + gruss kai

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: drucken

24.03.2005 11:18:32

GraFri

AW: drucken

24.03.2005 12:28:24

Kai

Hallo
Vielleicht hilft dir folgender Code weiter. Hab ich mal irgendwo im Net gefunden.
Ist zwar sehr lang, aber er funktioniert bei mir.

' -----------------------------------------------------
' API-Deklarationen - Druckerwechsel
' -----------------------------------------------------
Private Declare Function GetVersionEx Lib "kernel32" _
  Alias "GetVersionExA" _
  (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformID As Long
  szCSDVersion As String * 128
End Type

Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
' -----------------------------------------------------
' Standarddrucker-Wechsel unter Win2k/XP
' -----------------------------------------------------
Private Declare Function SetPrinterDef Lib "winspool.drv" _
  Alias "SetDefaultPrinterA" ( _
  ByVal lpPrinter As String) As Long

' -----------------------------------------------------
' Standarddrucker-Wechsel unter Win9x
' -----------------------------------------------------
Private Declare Function OpenPrinter Lib "winspool.drv" _
  Alias "OpenPrinterA" ( _
  ByVal pPrinterName As String, _
  phPrinter As Long, _
  pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" ( _
  ByVal hPrinter As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" _
  Alias "GetPrinterA" ( _
  ByVal hPrinter As Long, _
  ByVal Level As Long, _
  pPrinter As Any, _
  ByVal cbBuf As Long, _
  pcbNeeded As Long) As Long
Private Declare Function SetPrinter Lib "winspool.drv" _
  Alias "SetPrinterA" ( _
  ByVal hPrinter As Long, _
  ByVal Level As Long, _
  pPrinter As Any, _
  ByVal Command As Long) As Long
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Type DEVMODE
  dmDeviceName As String * CCHDEVICENAME
  dmSpecVersion As Integer
  dmDriverVersion As Integer
  dmSize As Integer
  dmDriverExtra As Integer
  dmFields As Long
  dmOrientation As Integer
  dmPaperSize As Integer
  dmPaperLength As Integer
  dmPaperWidth As Integer
  dmScale As Integer
  dmCopies As Integer
  dmDefaultSource As Integer
  dmPrintQuality As Integer
  dmColor As Integer
  dmDuplex As Integer
  dmYResolution As Integer
  dmTTOption As Integer
  dmCollate As Integer
  dmFormName As String * CCHFORMNAME
  dmUnusedPadding As Integer
  dmBitsPerPel As Long
  dmPelsWidth As Long
  dmPelsHeight As Long
  dmDisplayFlags As Long
  dmDisplayFrequency As Long
End Type
Private Type PRINTER_DEFAULTS
  pDatatype As String
  pDevMode As DEVMODE
  DesiredAccess As Long
End Type
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ATTRIBUTE_DEFAULT = &H4
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
  PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
' -----------------------------------------------------
' Standarddrucker-Wechsel unter WinNT4
' -----------------------------------------------------
Private Declare Function GetProfileString Lib "kernel32" _
  Alias "GetProfileStringA" _
  (ByVal lpAppName As String, _
  ByVal lpKeyName As String, _
  ByVal lpDefault As String, _
  ByVal lpReturnedString As String, _
  ByVal nSize As Long) As Long
'Copies a string into the specified section of the WIN.INI file
Private Declare Function WriteProfileString Lib "kernel32" _
  Alias "WriteProfileStringA" _
  (ByVal lpszSection As String, _
  ByVal lpszKeyName As String, _
  ByVal lpszString As String) As Long
Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long
  Public Const HWND_BROADCAST = &HFFFF&
  Public Const WM_WININICHANGE = &H1A
  Public DruckerName As String
  Public altIndex As Integer

  Private Const LB_GETITEMHEIGHT = &H1A1
' -----------------------------------------------------
' Beispiel: Standarddrucker-Wechsel
' -----------------------------------------------------
Sub Beispiel_Drucker_wechseln()
Dim Antwort
Antwort = Drucker_wechseln("OKIPAGE 10ex")
End Sub
'
' -----------------------------------------------------

' Standarddrucker-Wechsel
Public Function Drucker_wechseln(ByVal sPrinter As String) As Boolean
  Dim OSVersion As OSVERSIONINFO
  Dim nResult As Long
  Dim hPrinter As Long
  Dim nInfo() As Long
  Dim udtPrinter As PRINTER_DEFAULTS
  Dim sBuffer As String
  Dim sDriverName As String
  Dim sPort As String

  ' Welches Betriebssystem wird verwendet?
  With OSVersion
    .dwOSVersionInfoSize = Len(OSVersion)
    GetVersionEx OSVersion

    If (.dwPlatformID = VER_PLATFORM_WIN32_NT) And _
      (.dwMajorVersion > 4) Then

      ' Windows 2000 / XP
      nResult = SetPrinterDef(sPrinter)
      Drucker_wechseln = (nResult <> 0)

    ElseIf (.dwPlatformID = VER_PLATFORM_WIN32_NT) And _
      (.dwMajorVersion = 4) Then

      ' Windows NT 4
      sBuffer = Space(1024)
      ' Treiber und Port aus WIN.INI auslesen
      nResult = GetProfileString("PrinterPorts", sPrinter, "", sBuffer, Len(sBuffer))
      GetDriverAndPort sBuffer, sDriverName, sPort
      If sDriverName <> "" And sPort <> "" Then
        ' Neuen Standard-Drucker setzen (in WIN.INI schreiben)
        sBuffer = sPrinter & "," & sDriverName & "," & sPort
        WriteProfileString "windows", "Device", sBuffer
        Drucker_wechseln = True

        ' System über Änderung benachrichtigen
        SendMessage HWND_BROADCAST, WM_WININICHANGE, 0, 0
      End If

    Else
      ' Windows 9x
      With udtPrinter
        .DesiredAccess = PRINTER_ALL_ACCESS
      End With
      If OpenPrinter(sPrinter, hPrinter, udtPrinter) <> 0 Then
        GetPrinter hPrinter, 5, ByVal 0&, 0&, nResult
        ReDim nInfo(nResult \ 4)
        GetPrinter hPrinter, 5, nInfo(0), nResult, nResult
        nInfo(2) = nInfo(2) Or PRINTER_ATTRIBUTE_DEFAULT
        If SetPrinter(hPrinter, 5, nInfo(0), 0&) <> 0 Then
          Drucker_wechseln = True
        End If
        ClosePrinter hPrinter
      End If
    End If
  End With
End Function
Private Sub GetDriverAndPort(ByVal sBuffer As String, sDriverName As String, sPort As String)
  Dim nDriver As Integer
  Dim nPort As Integer

  sDriverName = ""
  sPort = ""
Bei weiteren Fragen einfach melden.
mfg, GraFri

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread