Se quiserem eu envio a minha rotina de impressão de nota utilizo tb o método printer é um pocuo extensa, mas se quiserem olhar é:
rotina da impressão dos itens:
Sub S_Impr_Detalhe()
Dim T_Temp As String
If Rs_Tp_Itens("Impr_Dados").Value Then 'se Imprime Origem
Printer.FontName = Rs_Tp_Itens("Fonte_Dados").Value
Printer.FontSize = Rs_Tp_Itens("Tamanho_Dados").Value
Printer.FontItalic = Rs_Tp_Itens("Italico_Dados").Value
Printer.FontBold = Rs_Tp_Itens("Negrito_Dados").Value
Printer.FontUnderline = Rs_Tp_Itens("Sublinhado_Dados").Value
Printer.CurrentY = T_Lin 'Superior
If Rs_Tp_Itens("Conteudo").Value <> "" Then 'conteudo
Rt_Label_Impr.Caption = Rs_Tp_Itens("Conteudo").Value
Else
Rt_Label_Impr.Caption = IIf(IsNull(Rc_Dados_Rel((Rs_Tp_Itens("Origem"))).Value), "", Rc_Dados_Rel((Rs_Tp_Itens("Origem"))).Value)
Rt_Label_Impr.Caption = G_Formata(Rt_Label_Impr.Caption, Rs_Tp_Itens("Decimais").Value, Rs_Tp_Itens("Milhar").Value, IIf(IsNull(Rs_Tp_Itens("Formatacao").Value), "", Rs_Tp_Itens("Formatacao").Value))
End If
If Rs_Tp_Itens("Alinha_Direita").Value Then 'alinha a direita
Printer.FontName = Rs_Tp_Itens("Fonte_Dados").Value
Printer.FontSize = Rs_Tp_Itens("Tamanho_Dados").Value
Printer.FontItalic = Rs_Tp_Itens("Italico_Dados").Value
Printer.FontBold = Rs_Tp_Itens("Negrito_Dados").Value
Printer.FontUnderline = Rs_Tp_Itens("Sublinhado_Dados").Value
Printer.CurrentX = Rs_Tp_Itens("Esquerda_Dados").Value - (Rt_Label_Impr.Width / 567)
Else
Printer.CurrentX = Rs_Tp_Itens("Esquerda_Dados").Value 'esquerda
End If
If Rs_Tp_Itens("Origem") = "ST" Then
If Rt_Label_Impr.Caption = "" Then Rt_Label_Impr.Caption = "00"
End If
If Rs_Tp_Itens("Condicional").Value Then 'se condicional (imprime se tem valor)
If Rt_Label_Impr.Caption <> "" And Rt_Label_Impr.Caption <> "0" Then
Printer.Print Rt_Label_Impr.Caption;
End If
Else
Printer.Print Rt_Label_Impr.Caption;
End If
End If
End Sub
rotina da impressão da Nota:
Private Sub S_imprimir_NF(t_indice As Long)
On Error GoTo Err_S_imprimir_NF
Dim Rc_Temp As Recordset, T_Obs As String, T_Tam As Long, T_Mudou As Boolean, T_Ini As Long
Dim T_Temp As String
Dim rr As Recordset
Dim T_EndCli As String, T_EndCliCobr As String
If Rt_Tipo_Cobr.Text = 2 Then
G_Mens "Tipo de cobrança invalido para Impressão da NF", MEN_INFORMA
Exit Sub
End If
S_Destr_Bt "BT_imprimir", False
Screen.MousePointer = 11
Base_Termin.Execute "DELETE Impr_Nota.* FROM Impr_Nota;"
Set Rc_Temp = Base_Duplic.OpenRecordset("SELECT Duplicatas.* From Duplicatas Where (((Duplicatas.NF) = " & NF.Text & ")) ORDER BY Duplicatas.Numero;")
If Rc_Temp.RecordCount = 0 Then
G_Mens "Não existem duplicatas para esta NF", MEN_INFORMA
Else
Rc_Temp.MoveMax
T_Tam = Rc_Temp.RecordCount
Rc_Temp.MoveMin
End If
Base_Termin.Execute "DELETE Impr_Nota.* FROM Impr_Nota;"
Set Rc_Dados_Rel = Base_Termin.OpenRecordset("Impr_Nota")
If Rc_Dados_Rel.RecordCount > 0 Then
Rc_Dados_Rel.Edit
Else
Rc_Dados_Rel.AddNew
End If
AA = 14 + (T_Tam - 1) * 3
For T_Cont = 14 To AA Step 3 'datas e valores das duplicatas
Rc_Dados_Rel(T_Cont) = "- - - - -"
Next
If T_Tam > 9 Then
T_Obs = "Relação das Duplicatas: "
Do Until Rc_Temp.EOF
T_Obs = T_Obs & Rc_Temp("Numero") & " = " & Rc_Temp("Valor") & ", "
Rc_Temp.MoveNext
Loop
T_Obs = Left(T_Obs, Len(T_Obs) - 2)
Else
T_Cont = 13
Do Until Rc_Temp.EOF
Rc_Dados_Rel(T_Cont) = Rc_Temp("Numero")
Rc_Dados_Rel(T_Cont + 1) = Rc_Temp("Vencimento")
Rc_Dados_Rel(T_Cont + 2) = Rc_Temp("Valor")
T_Cont = T_Cont + 3
Rc_Temp.MoveNext
Loop
End If
If TT <> 0 Then
T_Obs = T_Obs + "Valor da Mercadoria para Efeito de Substituição Tributária: R$ " & Str(Format(TT, "###,##0.00"))
Set rr = Base_NotasF.OpenRecordset("Notas")
rr.Index = "Pedido"
rr.Seek "=", Ped.Text
If Not rr.NoMatch Then
rr.Edit
rr("Obs") = T_Obs
rr.Update
End If
End If
If t_indice <> 1 Then T_Obs = T_Obs + " Folha nº " & t_indice & "/" & t_indice
Rc_Dados_Rel("NF") = NF.Text
Rc_Dados_Rel("Duplicata") = Duplicata.Text
Rc_Dados_Rel("Desc_Nat") = Rc_Natureza("Descricao")
Rc_Dados_Rel("OPOF") = Rc_Natureza("CFOP")
Rc_Dados_Rel("Nome_R") = Rc_Clientes("Nome_R")
Rc_Dados_Rel("CGC_Cli") = Rt_CGC.FormattedText
Rc_Dados_Rel("Endereco") = Rt_Endereco.Text
Rc_Dados_Rel("Bairro") = Rt_Bairro.Text
Rc_Dados_Rel("Cep_Cli") = Rt_CEP.FormattedText
Rc_Cidade.Seek "=", Rc_Clientes("Cod_Cidade")
If Not Rc_Cidade.NoMatch Then
Rc_Dados_Rel("Cid_Cli") = Rc_Cidade("Cidade")
End If
Rc_Dados_Rel("Fone_Fax") = "0xx" & Rc_Clientes("DDDTel") & " " & Rc_Clientes("Telefone")
Rc_Dados_Rel("UF_Cli") = Rt_UF.Text
Rc_Dados_Rel("IE") = Rt_IE.Text
T_EndCli = "" & Rc_Clientes("Cod_Cidade") & Rc_Clientes("CEP") & Rc_Clientes("Endereco") & Rc_Clientes("Bairro")
T_EndCliCobr = "" & Rc_Clientes("Cod_Cidade_Cob") & Rc_Clientes("CEP_Cob") & Rc_Clientes("Endereco_Cob") & Rc_Clientes("Bairro_Cob")
If T_EndCli <> T_EndCliCobr Then
Rc_Dados_Rel("End_Cobr") = Rc_Clientes("Endereco_Cob") & " - " & Rc_Clientes("Bairro_Cob") & " - " & Rc_Clientes("CEP_Cob")
Rc_Cidade.Seek "=", Rc_Clientes("Cod_Cidade_Cob")
If Not Rc_Cidade.NoMatch Then Rc_Dados_Rel("End_Cobr") = Rc_Dados_Rel("End_Cobr") & " - " & Rc_Cidade("Cidade") & " - " & Rc_Cidade("Estado")
End If
Rc_Dados_Rel("Nom_Tr") = Rt_Nome_Transp.Text
Rc_Dados_Rel("CGC_T") = Rt_CGC_Transp.FormattedText
Rc_Dados_Rel("End_T") = Rt_End_Transp.Text
If Rt_End_Transp.Text <> "" Then
Rc_Cidade.Seek "=", Rc_Transp("Cod_Cidade")
If Not Rc_Cidade.NoMatch Then
Rc_Dados_Rel("Mun_T") = Rc_Cidade("Cidade")
Rc_Dados_Rel("UF_T") = Rc_Cidade("Estado")
End If
Rc_Dados_Rel("IE_T") = Rt_IE_Transp.Text
Rc_Dados_Rel("Esp_c") = Especie_Carga.Text
End If
Rc_Dados_Rel("Obs_Dupl") = Obs.Text & Local_Entrega.Text & T_Obs
If CSng(VDesconto) > 0 Then
Rc_Dados_Rel("Obs_Dupl") = Rc_Dados_Rel("Obs_Dupl") & " Desconto promocional de: $ " & VDesconto
End If
Rc_Dados_Rel.Update
Base_Termin.Execute "DELETE Itens_Rel_Pers.* FROM Itens_Rel_Pers;"
Base_Termin.Execute "INSERT INTO Itens_Rel_Pers SELECT IR.* FROM [" & Base_Public.Name & "].Itens_Rel_Pers AS IR WHERE (((IR.Guia)=1));"
On Error GoTo Err_S_imprimir_NF2
T_Sql = "SELECT [IMP].*, INF.*, NT.*, Produtos.Cod_Prod as Cod_Prod, Produtos.Descricao AS Descricao, UN.Sigla AS Unid, [INF]![Quantidade]*[INF]![Vlr_Unitario] AS Vlr_Total, Sit_Tributaria.Descricao AS ST, NT.NF AS NF1, INF.Tipo_Prod, INF.icm as icms " & _
"FROM [" & Base_Termin.Name & "].Impr_Nota AS IMP INNER JOIN Notas AS NT ON [IMP].NF = NT.NF, [" & Base_Termin.Name & "].Itens_Pedidos AS INF INNER JOIN (([" & Base_Produt.Name & "].Produtos INNER JOIN [" & Base_Produt.Name & "].Unidades AS UN ON Produtos.Cod_Unidade = UN.Codigo) INNER JOIN [" & Base_Produt.Name & "].Sit_Tributaria ON Produtos.Sit_Tributaria" & Rc_Natureza("Sit_Tributaria") & " = Sit_Tributaria.Codigo) ON INF.Cod_Prod = Produtos.Codigo " & _
"Where (((INF.Tipo_Prod) = " & t_indice & ")) " & _
"ORDER BY Produtos.Cod_Prod;"
Set Rc_Dados_Rel = Base_NotasF.OpenRecordset(T_Sql)
' Dim rc_teste As Recordset
' Set rc_teste = Base_Pedido.OpenRecordset("SELECT Itens_Pedidos.* FROM Itens_Pedidos INNER JOIN Pedidos ON Itens_Pedidos.Cod_Pedido = Pedidos.Codigo WHERE (((Pedidos.Pedido)=" & Pedido.Text & "));")
' rc_teste.MoveMax
' If rc_teste.RecordCount <> Rc_Dados_Rel.RecordCount Then
' MsgBox ("Tem Problema no Cadastro de PRODUTOS, Chame o Responsável")
' Screen.MousePointer = 0
' Exit Sub
' End If
If Rc_Dados_Rel.RecordCount = 0 Then
G_Mens "Não foi possivel achar os dados da NF", MEN_INFORMA
Exit Sub
End If
Set rs = Base_Public.OpenRecordset("SELECT RP.* FROM Rel_Pers AS RP Where (((RP.Indice) = 1));")
If rs.RecordCount = 0 Then
G_Mens "Não foi possivel achar o Cabeçalho de Impressão", MEN_INFORMA
Exit Sub
End If
Set Rs_Tp_Itens = Base_Termin.OpenRecordset("Itens_Rel_Pers")
Rs_Tp_Itens.Index = "Indice"
If Rs_Tp_Itens.RecordCount = 0 Then
G_Mens "Não foi possivel achar os Dados de Impressão", MEN_INFORMA
Exit Sub
End If
'Inicio da Impressao
On Error Resume Next
If Not F_Setar_Impres("NF") Then Exit Sub
On Error GoTo Err_S_imprimir_NF2
Printer.Orientation = rs("Orientacao")
Printer.ColorMode = 1 'impressão Monocromatica
Printer.ScaleMode = vbCentimeters
Printer.ForeColor = 0
Printer.PrintQuality = rs("Qualidade")
Qtd_Folha = 1
For T_Cont = 1 To Qtd_Folha 'Repete quanta vezes por folha
Err = 0
Rs_Tp_Itens.MoveMin
Do Until Rs_Tp_Itens.EOF
If Rs_Tp_Itens("Posicao") = 3 Then 'se Detalhes
T_Inic_Detalhes = Rs_Tp_Itens("Indice")
T_Lin = Rs_Tp_Itens("Superior_Dados")
Do Until Rc_Dados_Rel.EOF
Rs_Tp_Itens.Seek "=", T_Inic_Detalhes
Do Until Rs_Tp_Itens("Posicao") <> 3
S_Impr_Detalhe
Rs_Tp_Itens.MoveNext
If Rs_Tp_Itens.EOF Then Exit Do
Loop
T_Lin = T_Lin + rs("Alt_Detalhe") 'muda a linha do detalhe
Rc_Dados_Rel.MoveNext
Loop
Rc_Dados_Rel.MoveMax
End If
If Rs_Tp_Itens.EOF Then Exit Do
If Err = 0 Then
T_Imprime = True
If Rs_Tp_Itens("Condicional").Value Then 'se condicional (imprime se tem valor)
T_Obs = "" & Rs_Tp_Itens("Conteudo").Value
If T_Obs = "" Then
Rt_Label_Impr.Caption = IIf(IsNull(Rc_Dados_Rel((Rs_Tp_Itens("Origem"))).Value), "", Rc_Dados_Rel((Rs_Tp_Itens("Origem"))).Value)
Rt_Label_Impr.Caption = G_Formata(Rt_Label_Impr.Caption, Rs_Tp_Itens("Decimais").Value, Rs_Tp_Itens("Milhar").Value, IIf(IsNull(Rs_Tp_Itens("Formatacao").Value), "", Rs_Tp_Itens("Formatacao").Value))
If IsNumeric(Rt_Label_Impr.Caption) Then
If CDbl(Rt_Label_Impr.Caption) = 0 Then T_Imprime = False
Else
If Rt_Label_Impr.Caption = "" Then T_Imprime = False
End If
End If
End If
If Rs_Tp_Itens("Impr_Rotulo").Value And T_Imprime Then 'se impr. rotulo
If Rs_Tp_Itens("Condicional").Value Then 'se condicional (imprime se tem valor)
If Rs_Tp_Itens("Conteudo").Value = "" Then 'conteudo
Rt_Label_Impr.Caption = Rc_Dados_Rel((Rs_Tp_Itens("Origem"))).Value
If IsNull(Rt_Label_Impr.Caption) Then Rt_Label_Impr.Caption = ""
If Rt_Label_Impr.Caption <> "" And Rt_Label_Impr.Caption <> "0" Then
Printer.FontName = Rs_Tp_Itens("Fonte_Rotulo").Value
Printer.FontSize = Rs_Tp_Itens("Tamanho_Rotulo").Value
Printer.FontItalic = Rs_Tp_Itens("Italico_Rotulo").Value
Printer.FontBold = Rs_Tp_Itens("Negrito_Rotulo").Value
Printer.FontUnderline = Rs_Tp_Itens("Sublinhado_Rotulo").Value
Printer.CurrentY = Rs_Tp_Itens("Superior_Rotulo").Value
Printer.CurrentX = Rs_Tp_Itens("Esquerda_Rotulo").Value
Printer.Print Rs_Tp_Itens("Rotulo").Value;
End If
End If
End If
End If
If Rs_Tp_Itens("Impr_Dados").Value And T_Imprime Then 'se Imprime Origem
Printer.FontName = Rs_Tp_Itens("Fonte_Dados").Value
Printer.FontSize = Rs_Tp_Itens("Tamanho_Dados").Value
Printer.FontItalic = Rs_Tp_Itens("Italico_Dados").Value
Printer.FontBold = Rs_Tp_Itens("Negrito_Dados").Value
Printer.FontUnderline = Rs_Tp_Itens("Sublinhado_Dados").Value
Printer.CurrentY = Rs_Tp_Itens("Superior_Dados").Value 'Superior
If Rs_Tp_Itens("Largura_Dados").Value <> 0 Then 'se dados Delimitados em uma area
T_Obs = "" & Rs_Tp_Itens("Conteudo").Value
If T_Obs <> "" Then
T_Obs = Rs_Tp_Itens("Conteudo").Value
Else
T_Obs = "" & Rc_Dados_Rel((Rs_Tp_Itens("Origem"))).Value
End If
T_Ini = 1
T_Lin = Rs_Tp_Itens("Superior_Dados")
Do
If T_Lin > Rs_Tp_Itens("Superior_Dados") + Rs_Tp_Itens("Altura_Dados") Then Exit Do
T_Tam = 0
T_Temp = ""
T_Temp = G_SepTexto(T_Obs, T_Ini, Rs_Tp_Itens("Largura_Dados").Value, T_Tam)
If Len(T_Temp) <> 0 Then 'se tem o que imprimit
Printer.CurrentY = T_Lin 'superior
If Rs_Tp_Itens("Indice") = 2 And Tipo.Text = "E" Then
Printer.CurrentX = Rs_Tp_Itens("Esquerda_Dados").Value + 2.35 'esquerda
Else
Printer.CurrentX = Rs_Tp_Itens("Esquerda_Dados").Value 'esquerda
End If
Printer.Print T_Temp;
T_Lin = T_Lin + rs("Alt_Detalhe") 'muda a linha do detalhe
End If
If T_Tam = 0 Then Exit Do
T_Ini = T_Tam
Loop
Else
Rt_Label_Impr.Caption = ""
If Rs_Tp_Itens("Conteudo").Value <> "" Then 'conteudo
Rt_Label_Impr.Caption = Rs_Tp_Itens("Conteudo").Value
Else
Rt_Label_Impr.Caption = IIf(IsNull(Rc_Dados_Rel((Rs_Tp_Itens("Origem"))).Value), "", Rc_Dados_Rel((Rs_Tp_Itens("Origem"))).Value)
Rt_Label_Impr.Caption = G_Formata(Rt_Label_Impr.Caption, Rs_Tp_Itens("Decimais").Value, Rs_Tp_Itens("Milhar").Value, IIf(IsNull(Rs_Tp_Itens("Formatacao").Value), "", Rs_Tp_Itens("Formatacao").Value))
End If
If Rs_Tp_Itens("Alinha_Direita").Value Then 'alinha a direita
Printer.FontName = Rs_Tp_Itens("Fonte_Dados").Value
Printer.FontSize = Rs_Tp_Itens("Tamanho_Dados").Value
Printer.FontItalic = Rs_Tp_Itens("Italico_Dados").Value
Printer.FontBold = Rs_Tp_Itens("Negrito_Dados").Value
Printer.FontUnderline = Rs_Tp_Itens("Sublinhado_Dados").Value
If Rs_Tp_Itens("Indice") = 2 And Tipo.Text = "E" Then
Printer.CurrentX = (Rs_Tp_Itens("Esquerda_Dados").Value + 2.35) - (Rt_Label_Impr.Width / 567)
Else
Printer.CurrentX = Rs_Tp_Itens("Esquerda_Dados").Value - (Rt_Label_Impr.Width / 567)
End If
Else
If Rs_Tp_Itens("Indice") = 2 And Tipo.Text = "E" Then
Printer.CurrentX = Rs_Tp_Itens("Esquerda_Dados").Value + 2.35 'esquerda
Else
Printer.CurrentX = Rs_Tp_Itens("Esquerda_Dados").Value 'esquerda
End If
End If
Printer.Print Rt_Label_Impr.Caption;
End If
End If
End If
Err = 0
Rs_Tp_Itens.MoveNext
Loop
Next
Printer.EndDoc
Screen.MousePointer = 0
Exit Sub
Err_S_imprimir_NF:
G_Erro "Bt_Atualizar", Me.Name, "Não foi possivel selecionar os dados para a impressão", Err.Source, Err.Description, Err.Number, Err.HelpFile, Err.HelpContext, True
Screen.MousePointer = 0
Resume
Exit Sub
Err_S_imprimir_NF2:
G_Erro "Bt_Atualizar", Me.Name, "Não foi selecionar os dados da NF paraimpressão", Err.Source, Err.Description, Err.Number, Err.HelpFile, Err.HelpContext, True
Printer.KillDoc
Screen.MousePointer = 0
Exit Sub
End Sub
