aqui está la solución
primero en un modulo .bas declaas lo sgte:
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
#If Win32 Then
Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, 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 Any) As Long
#Else
Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any) As Integer
Declare Function SendMessage Lib "User" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lparam As Any) As Long
#End If
Global Const HWND_BROADCAST = &HFFFF
Global Const WM_WININICHANGE = &H1A
' Ademas las sgtes funciones
Function VBGetDefPrinter() As String
Dim sBuffer As String
Dim lRet As Long
Dim iFound As Integer
Dim iFound2 As Integer
sBuffer = String$(128, 0)
lRet = GetProfileString("Windows", "Device", "", sBuffer, Len(sBuffer))
If lRet = 0 Then Exit Function
sBuffer = Left$(sBuffer, lRet)
iFound = InStr(sBuffer, ",")
If iFound = 0 Then Exit Function
iFound2 = InStr(iFound + 1, sBuffer, ",")
If iFound2 = 0 Then Exit Function
VBGetDefPrinter = Left$(sBuffer, iFound - 1) + " on " + Mid$(sBuffer, iFound2 + 1)
End Function
Function VBSetDefPrinter(sPrinter As String) As Integer
Dim sBuffer As String
Dim lRet As Long
Dim iFound As Integer
Dim iFound2 As Integer
Dim sPort As String
Dim sName As String
Dim sTemp As String
Dim sNewName As String
iFound = InStr(sPrinter, " on ")
If iFound = 0 Then Exit Function
sPort = Mid$(sPrinter, iFound + 4)
sName = Left$(sPrinter, iFound - 1)
sBuffer = String$(2048, 0)
lRet = GetProfileString("PrinterPorts", 0&, "", sBuffer, Len(sBuffer))
If lRet = 0 Then Exit Function
sBuffer = Left$(sBuffer, lRet)
iFound = InStr(sBuffer, sName)
While iFound <> 0
sTemp = String$(128, 0)
sNewName = Mid$(sBuffer, iFound, InStr(iFound + 1, sBuffer, Chr$(0)) - iFound)
lRet = GetProfileString("PrinterPorts", sNewName, "", sTemp, Len(sTemp))
sTemp = Left$(sTemp, lRet)
iFound2 = InStr(sTemp, ",")
If iFound2 <> 0 Then
If sPort = Mid$(sTemp, iFound2 + 1, Len(sPort)) Then
iFound2 = InStr(iFound2 + 1, sTemp, ",")
If iFound2 <> 0 Then sTemp = Left$(sTemp, iFound2 - 1)
lRet = WriteProfileString("Windows", "Device", sNewName + "," + sTemp)
lRet = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal 0&)
VBSetDefPrinter = -lRet
Exit Function
End If
End If
iFound = InStr(iFound + 1, sBuffer, sName)
Wend
End Function
' Después en el boton imprimir agregas el sgte codigo
Private Imprimir_click()
Dim MiPrinter As String
On Error GoTo errh
'Guarda el nombre de la impresora predeterminada
MiPrinter = VBGetDefPrinter
'El usuario puede cancelar
Cdialog.CancelError = True
'Muestra el dialogo de impresion
Cdialog.ShowPrinter
'El Commondialog ya cambio la impresora predeterminada del sistema
'Manda a imprimir el form
FrmXxxxX.print
'Regresa todo a la normalidad
VBSetDefPrinter (MiPrinter)
Impresora = VBGetDefPrinter
VBSetDefPrinter (Impresora)
Exit Sub
errh:
Exit Sub
End sub
'''No olvides Agregar el commondialog que en este caso se llama Cdialog
''Suerte