Olá,

 

Tenho um programa em VB 6.0 para imprimir directamente numa impressora um Report. Nesse programa tenho um objecto do tipo CommonDialog para permitir ao utilizador escolher uma qualquer impressora. Eis o código que utilizo:

 

 

Mas se o utilizador escolher uma impressora qualquer, a impressão vai sempre para a impressora por defeito. Se escolher outra, tem que sair da aplicação para que isso se verifique. Obrigado.

Francisco, eu uso um Form, com duas combo, para o usuário escolher veja parte do código, acho que voce pode fazer assim, fica muito bom:

As variaveis são públicas voce pode chamar de qualquer Form.

Coloquei dois botões, um IMPRIME, outro CANCELA.

 

NO FORMULARIO (Escolhe impressora)

Private Sub Form_Load()
    cboIMPRIME.Clear
    iESCOLHE = 0
    inrCOPIAS = 1
    cboCOPIAS.Text = "1"
    If VERIFICAIMPRESSORAINSTALADA = True Then
        cboIMPRIME.Text = Printer.DeviceName
        For Each nrIMPRESSORA In Printers
            cboIMPRIME.AddItem nrIMPRESSORA.DeviceName
        Next
        cmdIMPRIME.Enabled = True
    Else
        cmdIMPRIME.Enabled = False
    End If
    MousePointer = 0
End Sub
Private Sub cmdIMPRIME_Click()
    MousePointer = 11
    For Each nrIMPRESSORA In Printers
        If nrIMPRESSORA.DeviceName = cboIMPRIME.Text Then
            Set Printer = nrIMPRESSORA
            Exit For
        End If
    Next

End Sub

 

EM UM MÓDULO:

Public Function VERIFICAIMPRESSORAINSTALADA()
  On Error Resume Next
  Dim sNOMEIMPRESSORA As String
    sNOMEIMPRESSORA = Printer.DeviceName
    If Err.Number Then
        VERIFICAIMPRESSORAINSTALADA = False
    Else
        VERIFICAIMPRESSORAINSTALADA = True
    End If
    Exit Function
End Function

 

PARA CHAMAR DOS Formulários:

Private Sub cmdIMPRIME_Click()
    iESCOLHE = 0
    frmESCOLHE.Show vbModal
    If iESCOLHE = 1 Then
        IMPRIMEOARQUIVO
    End If

End Sub

 

 

Agora com voce.

 

vlu//

 

Não se esqueça se o usuário escolher a impressora, retornar a varialvel iESCOLHE = 1.

A impressora escolhida torna-se padrão enquanto o VB estiver executando, ao sair retorna a impressora padrão.

 

vlu//

Eu coloquei no |Informações do Sistema e Funcionou, Bem

 

 

Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetProfileString Lib "kernel32.dll" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
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

' pega as informacoes da impressora padrao
  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
          ' se achou a impressora padrao entao sai
          Exit For
        End If
   Next
   ' se nao achou retrona nothing
  If objPrinter.DeviceName <> tblDefaultPrinterInfo(0) Then
      Set objPrinter = Nothing
  End If
 ' Set GetDefaultPrinter = objPrinter
 
End Function

Private Sub Form_Load()
lblVersion.Caption = "Versão  " & App.Major & "." & App.Minor & "." & App.Revision

With Label3(1)
       .AutoSize = True
       .ForeColor = vbBlue
       .Font.Underline = True
       .Caption = "njnews@bol.com.br"
    End With
End Sub

Private Sub GBImpriessora_Click()
 Dim PaginaInicial, Paginafinal, numerodecopias, i
    CommonDialog1.CancelError = True
    On Error GoTo TrataErro

    'mostra a janela para impressora
    CommonDialog1.ShowPrinter
    'Captura os valores definidos pelo usuário na janela
    PaginaInicial = CommonDialog1.FromPage
    Paginafinal = CommonDialog1.ToPage
    numerodecopias = CommonDialog1.Copies
    For i = 1 To numerodecopias
        'aqui entra o seu código para imprimir
    Next
    Exit Sub

TrataErro:
    Exit Sub
End Sub

Private Sub Label3_Click(Index As Integer)
 Dim ret$
 ret = ShellExecute(Me.hwnd, "Open", "mailto:njnews@bol.com.br", "", "", 1)
 Label3(1).ForeColor = vbRed
End Sub

Private Sub GBSair_Click()
Unload FrmInformacaos
End Sub