Printer Dialog

Me parece que ya te he entendido, lo siento, pensaba que te referías a otra cosa...
Se me ocurre una posible solución que puede ser esta: previamente a mostrar el cuadro de dialogo de la impresora obtenemos cual es la predeterminada, posteriormente dejamos al usuario que imprima por la que desee y al finalizar la impresión volvemos a poner como predeterminada la que ya existía. ¿Qué te parece?
¿Te envío el código ok?
Determina cual es la impresora predeterminada
A través del siguiente ejemplo podremos determinar cual es la impresora predeterminada de windows.
Public Function GetDefaultPrinter() As Printer
Dim strBuffer As String * 254
Dim iRetValue As Long
Dim strDefaultPrinterInfo As String
Dim tblDefaultPrinterInfo() As String
Dim objPrinter As Printer
iRetValue = GetProfileString("windows", "device", ",,,", strBuffer, 254)
strDefaultPrinterInfo = Left(strBuffer, InStr(strBuffer, Chr(0)) - 1)
tblDefaultPrinterInfo = Split(strDefaultPrinterInfo, ",")
For Each objPrinter In Printers
If objPrinter.DeviceName = tblDefaultPrinterInfo(0) Then
'Impresora detectada
Exit For
End If
Next
'Si no se encuentra devuelve Nothing
If objPrinter.DeviceName <> tblDefaultPrinterInfo(0) Then
Set objPrinter = Nothing
End If
Set GetDefaultPrinter = objPrinter
End Function
Private Sub Form_Load()
Dim objPrinter As Printer
Set objPrinter = GetDefaultPrinter()
MsgBox "La impresora predeterminada es: " + objPrinter.DeviceName
MsgBox "El nombre del driver es: " + objPrinter.DriverName
MsgBox "El puerto es: " + objPrinter.Port
Set objPrinter = Nothing
End Sub
Como cambiar la impresora por defecto
La siguiente rutina nos muestra cómo podemos cambiar la impresora establecida por defecto en nuestro sistema.
Esta alternativa no cambia la impresora por defecto para las otras aplicaciones. Sólo lo hará para la aplicación que actualmente se está ejecutando.
Los pasos necesarios para implementar la alternativa:
1. Crear un nuevo proyecto el cual tendrá un nuevo form con un Listbox, un CommandButton y un módulo.
Añadiremos el siguiente código a un módulo:
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
Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal _
lpszKeyName As String, ByVal lpszString As String) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As String) As Long
Public Const HWND_BROADCAST = &HFFFF
Public Const WM_WININICHANGE = &H1A
2. En un formulario que contendrá un Listbox en la que se mostrarán las impresoras instaladas añadiremos adicionalmente,
un botón que nos permitirá seleccionar una de las impresoras que se muestran en las Listbox.
Código del CommandButton:
Dim r As Long
Dim Buffer As String
Dim DeviceName As String
Dim DriverName As String
Dim PrinterPort As String
Dim PrinterName As String
If List1.ListIndex > -1 Then
Buffer = Space(1024)
PrinterName = List1.Text
r = GetProfileString("PrinterPorts", PrinterName, "", Buffer, Len(Buffer))
GetDriverAndPort Buffer, DriverName, PrinterPort
If DriverName <> "" And PrinterPort <> "" Then
SetDefaultPrinter List1.Text, DriverName, PrinterPort
End If
End If
Código del evento Load del formulario:
Dim r As Long
Dim Buffer As String
Buffer = Space(8192)
r = GetProfileString("PrinterPorts", vbNullString, "", Buffer, Len(Buffer))
ParseList List1, Buffer
Funciones auxiliares a situar en la sección declaraciones del formulario:
Sub SetDefaultPrinter(ByVal PrinterName As String, ByVal DriverName As String, ByVal PrinterPort As String)
Dim DeviceLine As String
Dim r As Long
Dim l As Long
DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
r = WriteProfileString("windows", "Device", DeviceLine)
l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
End Sub
Sub ParseList(lstCtl As Control, ByVal Buffer As String)
Dim i As Integer
Do
i = InStr(Buffer, Chr(0))
If i > 0 Then
lstCtl.AddItem Left(Buffer, i - 1)
Buffer = Mid(Buffer, i + 1)
Else
lstCtl.AddItem Buffer
Buffer = ""
End If
Loop While i > 0
End Sub
Sub GetDriverAndPort(ByVal Buffer As String, DriverName As String, PrinterPort As String)
Dim r As Integer
Dim iDriver As Integer
Dim iPort As Integer
DriverName = ""
PrinterPort = ""
iDriver = InStr(Buffer, ",")
If iDriver > 0 Then
DriverName = Left(Buffer, iDriver - 1)
iPort = InStr(iDriver + 1, Buffer, ",")
If iPort > 0 Then
PrinterPort = Mid(Buffer, iDriver + 1, iPort - iDriver - 1)
End If
End If
End Sub