Option Explicit
 
Private PrintQuality(vbPRPQHigh To vbPRPQDraft) As String
 
Private Function GetQuality(ByVal S As String) As Long
  On Error Resume Next
 
  Dim l As Long, X As Long
 
  For X = LBound(PrintQuality) To UBound(PrintQuality)
    If PrintQuality(X) = S Then
      GetQuality = X
      Exit Function
    End If
  Next X
 
  GetQuality = 0
End Function
 
Private Sub Combo1_Click()
  Dim X As Long, lOldQuality As Long, sOldPrinter As String
  Dim P As Printer, Y As Long, bFound As Boolean, S As String
 
  Combo2.Clear
 
  If Combo1.ListIndex < 0 Then Exit Sub
 
  sOldPrinter = Printer.DeviceName
 
  For X = LBound(PrintQuality) To UBound(PrintQuality)
    PrintQuality(X) = ""
  Next X
 
  For Each P In Printers
    If P.DeviceName = Combo1.Text Then
      Set Printer = P
      Exit For
    End If
  Next P
  Set P = Nothing
 
  If Printer Is Nothing Then Exit Sub
 
  lOldQuality = Printer.PrintQuality
 
  For X = vbPRPQDraft To vbPRPQHigh Step -1
    bFound = False
    Printer.PrintQuality = X
    S = Printer.PrintQuality
 
    If IsNumeric(S) Then
      If (CLng(S) <= vbPRPQDraft) And (CLng(S) >= vbPRPQHigh) Then
        Select Case CLng(S)
          Case vbPRPQDraft: S = "Entwurf"
          Case vbPRPQLow: S = "Niedrig"
          Case vbPRPQMedium: S = "Normal"
          Case vbPRPQHigh: S = "Hoch"
        End Select
      Else
        S = S & " dpi"
      End If
    End If
 
    For Y = 0 To Combo2.ListCount
      If Combo2.List(Y) = S Then
        bFound = True
        Exit For
      End If
    Next Y
 
    If Not bFound Then
      Combo2.AddItem S
      PrintQuality(X) = S
    End If
  Next X
 
  Combo2.ListIndex = 0
  Printer.PrintQuality = lOldQuality
 
  For Each P In Printers
    If P.DeviceName = sOldPrinter Then
      Set Printer = P
      Exit For
    End If
  Next P
  Set P = Nothing
End Sub
 
Private Sub Command1_Click()
  MsgBox "Printer.DeviceName = " & Combo1.List(Combo1.ListIndex) & vbNewLine & _
    "Printer.PrintQuality = " & GetQuality(Combo2.List(Combo2.ListIndex))
End Sub
 
Private Sub Form_Load()
  Dim P As Printer, X As Long
 
  If Printers.Count < 0 Then
    MsgBox "Kein Drucker installiert!", vbCritical
  End If
 
  For Each P In Printers
    Combo1.AddItem P.DeviceName
  Next P
 
  For X = 0 To Combo1.ListCount
    If Printer.DeviceName = Combo1.List(X) Then
      Combo1.ListIndex = X
      Exit For
    End If
  Next X
 
  Set P = Nothing
End Sub

Viel Spass,
R@lf