Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Standarddruckenr definieren | Herbers Excel-Forum


Betrifft: Standarddruckenr definieren von: Dirk R.
Geschrieben am: 14.11.2009 09:52:10

Hallo Forumsmitglieder,

ich habe folgendes Problem und hoffe auf eure Hilfe!!!

Ich hätte gerne eine VBS Datei, die ich in den Autostart stellen würde. Diese Soll ermitteln, an welchem PC ich mich angemeldet habe und dann dementsprechend einen bestimmten drucker als Standard definieren.

z.B.:
If Environ("Computername") = "KOPCH419" Then ("Lex T640 - WB4 auf Ne01:" als Standarddrucker)
If Environ("Computername") = "KOPCH525" Then ("Lex T640 - ADL-C auf Ne01:" als Standarddrucker)
'
'

Im Archiv bin ich leider nicht fündig geworden.
Gruß
Dirk R.

  

Betrifft: vielleicht geht es so. von: Tino
Geschrieben am: 14.11.2009 10:25:46

Hallo,
kannst ja mal testen.

Private Declare Function RegEnumValue Lib "advapi32.dll" Alias _
  "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, _
  ByVal lpValueName As String, lpcbValueName As Long, ByVal _
  lpReserved As Long, lpType As Long, lpData As Byte, _
  lpcbData As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
  Alias "RegOpenKeyExA" (ByVal hKey As Long, _
  ByVal lpSubKey As String, ByVal ulOptions As Long, _
  ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" _
  (ByVal hKey As Long) As Long

Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const READ_CONTROL = &H20000
Private Const KEY_READ = (READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY)
Private Const HKEY_CURRENT_USER = &H80000001
Private Const Schlüsselname = "Software\Microsoft\Windows NT\CurrentVersion\Devices\"



Private Function FindDrucker(ByVal sDruckerName$) As String

Dim dummy, hwndSchlüssel&
Dim Länge&, lngIndex&
Dim strFeld As String, lngLänge As Long
Dim arrPuffer() As Byte, strPuffer As String
Dim lngArrLänge As Long, lngPortlänge As Long
Dim Drucker As String

  dummy = RegOpenKeyEx(HKEY_CURRENT_USER, _
    Schlüsselname, 0&, KEY_READ, hwndSchlüssel)
  If dummy <> 0 Then MsgBox "Falscher Schlüssel": Exit Function
  strFeld = String(1024, 0)
  lngLänge = 1023
  Redim arrPuffer(0 To 1000)
  
  Do While RegEnumValue(hwndSchlüssel, lngIndex, _
    strFeld, lngLänge, 0&, ByVal 0&, ByVal 0&, ByVal 0&) = 0
    
    Drucker = Left$(strFeld, lngLänge) & " auf "
    lngArrLänge = 1024
    
    RegEnumValue hwndSchlüssel, lngIndex, strFeld, _
      lngLänge, 0&, 0&, arrPuffer(0), lngArrLänge
    
    strPuffer = (StrConv(arrPuffer, vbUnicode))
    
    lngPortlänge = InStr(1, strPuffer, ":") - InStr(1, strPuffer, ",")
    
    strPuffer = Mid$(strPuffer, InStr(1, strPuffer, ":") - 4, lngPortlänge)
    strPuffer = Replace(strPuffer, ",", "")
    strPuffer = IIf(Right$(strPuffer, 1) = ":", strPuffer, strPuffer & ":")
    Drucker = Drucker & strPuffer
    
    If Drucker Like sDruckerName Then FindDrucker = Drucker: Exit Do
    lngIndex = lngIndex + 1
    strFeld = String(1024, 0)
    
    lngLänge = 1023
  Loop

  dummy = RegCloseKey(hwndSchlüssel)
End Function


Sub TestDruckerUmstellen()
Dim sAktuellerDrucker As String
Dim sDrucker As String

If Environ$("COMPUTERNAME") = "KOPCH419" Then
    'Drucker Suchen, Platzhalter verwenden 
    sDrucker = FindDrucker("Lex T640 - WB4*")
ElseIf Environ$("COMPUTERNAME") = "KOPCH525" Then
    'Drucker Suchen, Platzhalter verwenden 
    sDrucker = FindDrucker("Lex T640 - ADL*")
End If

'aktuellen Drucker in einem String merken 
sAktuellerDrucker = Application.ActivePrinter


If sDrucker <> "" Then
    Application.ActivePrinter = sDrucker
End If
    
    
    'hier Dein Code für den Ausdruck 
    '... 
    '... 


'Drucker wieder zurückstellen, sollte er umgestellt sein 
If sDrucker <> "" Then
 Application.ActivePrinter = sAktuellerDrucker
End If

End Sub
Gruß Tino


  

Betrifft: AW: vielleicht geht es so. von: Nepumuk
Geschrieben am: 14.11.2009 10:28:39

Hallo Tino,

API's kannst du in Scripten nicht benutzen. Und Dirk will ja ein Script (Ich hätte gerne eine VBS Datei)

Gruß
Nepumuk


  

Betrifft: ich denke er meint VBA, von: Tino
Geschrieben am: 14.11.2009 10:39:08

Hallo,
lassen wir uns überraschen. ;-)

Gruß Tino


  

Betrifft: AW: vielleicht geht es so. von: Dirk R.
Geschrieben am: 14.11.2009 10:48:45

Hallo Tino,

danke für deine rasche und aufwendige Hilfe.
Werde deinen Code auch testen, aber die Lösung von Nepumuk war in diesem Fall die Richtige.

Trotzdem vielen Dank!

Gruß
Dirk R.


  

Betrifft: AW: Standarddruckenr definieren von: Nepumuk
Geschrieben am: 14.11.2009 10:26:31

Hallo,

du bist zwar hier in einem Excelforum :-( , aber versuch es mal so :-) :

Dim vntWSHNetwork
Dim vntPrinters
Dim vntCounter

Set vntWSHNetwork = CreateObject("WScript.Network")

With vntWSHNetwork
    
    If .ComputerName = "KOPCH419" Or _
        .ComputerName = "KOPCH525" Then
        
        Set vntPrinters = .EnumPrinterConnections
        
        For vntCounter = 0 To vntPrinters.Count - 1 Step 2
            
            If .ComputerName = "KOPCH419" And vntPrinters.Item(vntCounter + 1) = "Lex T640 - WB4" Or _
                .ComputerName = "KOPCH525" And vntPrinters.Item(vntCounter + 1) = "Lex T640 - ADL-C" Then
                
                .SetDefaultPrinter vntPrinters.Item(vntCounter + 1)
                Exit For
                
            End If
            
        Next
        
    End If
    
    Set vntPrinters = Nothing
    
End With

Set vntWSHNetwork = Nothing

Gruß
Nepumuk


  

Betrifft: AW: Standarddruckenr definieren von: Dirk R.
Geschrieben am: 14.11.2009 10:46:27

Hallo Nepumuk,

vielen Dank für deine Hilfe!!!!
(auch wenn der Beitrag vielleicht hier in diesem Forum nicht an der richtigen stelle war) :o(

Dein Code funzt einwandfrei.

Nochmals vielen Dank!!!
Dirk R.