Tenho uma aqui que roda legal, altera para o layout que vc precisa...
Private Sub cmdImprimir_Click()
Dim POSICAO As Double
Dim dblNLinhasProd As Double 'qtd de linhas para produtos
Dim dblContaLinha As Double 'contador de linhas impressas
Dim dblPulaLinha As Double
Dim dblVlrTotalNota As Double
Dim blnImprimirNrNota As Boolean
Dim dblLinha As Double
Dim blnImprimirFaturas As Boolean
Arq = FreeFile
If SSTab1.Tab = 0 Then 'se for nota fiscal
If Len(GradeSumario.TextMatrix(GradeSumario.Row, 1)) = 0 Then
Exit Sub
End If
'
Screen.MousePointer = 11
For POSICAO = CDbl(GradeSumario.Row) To CDbl(GradeSumario.RowSel)
dblNLinhasProd = 14
dblNLinhasServ = 9
'
strSQL = ""
strSQL = strSQL & " Select * From Clientes"
strSQL = strSQL & " Where CodigoDoCliente = " & CDbl(GradeSumario.TextMatrix(GradeSumario.Row, 2))
If tblCliente.State = adStateOpen Then tblCliente.Close
tblCliente.CursorLocation = adUseClient
tblCliente.Open strSQL, adoBanco, adOpenForwardOnly, adLockReadOnly
'
dblNumeroDaNota = GradeSumario.TextMatrix(POSICAO, 4)
strDataEmissao = GradeSumario.TextMatrix(POSICAO, 5)
dblCodRem = GradeSumario.TextMatrix(POSICAO, 2)
strNomRem = GradeSumario.TextMatrix(POSICAO, 3)
dblNroCupom = GradeSumario.TextMatrix(POSICAO, 1)
dblVlrTotalNota = CDbl(GradeSumario.TextMatrix(POSICAO, 8))
strFrete = GradeSumario.TextMatrix(POSICAO, 10)
dblBaseICMS = 0
dblVlrICMS = 0
dblBaseICMSSubs = 0
dblVlrICMSSubs = 0
dblVlrFrete = 0
dblVlrSeguro = 0
dblVlrDespesas = 0
dblVlrIPI = 0
dblVlrDesconto = 0
dblSubTotal = 0
dblVlrServicos = 0
dblTotalProdutos = 0
dblBaseISS = 0
dblVlrISS = 0
'
strSQL = ""
strSQL = strSQL & " Select * From NotaFiscalCliente"
strSQL = strSQL & " Where NumeroDaNotaFiscal = " & CDbl(dblNumeroDaNota)
If tblNota.State = adStateOpen Then tblNota.Close
tblNota.CursorLocation = adUseClient
tblNota.Open strSQL, adoBanco, adOpenForwardOnly, adLockReadOnly
If blnCalcularIcmsNF = True Then
dblBaseICMS = Format(tblNota!VlrBaseICMS, "###0.00")
dblVlrICMS = Format(tblNota!VlrICMS, "###0.00")
dblVlrFrete = Format(tblNota!VlrDoFrete, "###0.00")
Else
dblBaseICMS = 0
dblVlrICMS = 0
End If
dblVlrISS = CDbl(tblNota!VlrISS) ' , "###0.00")
dblBaseISS = CDbl(tblNota!VlrBaseISS) ', "###0.00")
blnImprimirFaturas = IIf((tblNota!FG_Impr_Fatura = "S"), True, False)
'
Open strImpressoraDeFormulario For Output As #Arq
Print #Arq, Chr(15)
Print #Arq, Chr(27) + "3" + Chr(0) 'definir espacamento entre linhas , aumentar ou diminuir
Print #Arq, Chr(27) & "E" 'habilitar negrito
If GradeSumario.TextMatrix(GradeSumario.Row, 9) = "S" Then
'imprimir letra grande
Print #Arq, Tab(115); Chr(27) + "G"; Chr(18); Chr(27) + Chr(69); Format(Mid(dblNumeroDaNota, 1, 6), "000000"); Chr(27) + "3" + Chr(27); Chr(27) + Chr(70); Chr(27) + Chr(71);
Print #Arq, Chr(27) + "3" + Chr(40)
Print #Arq, Chr(15)
Print #Arq, Tab(86); Chr(27) + "G"; Chr(18); Chr(27) + Chr(69); "X"; Chr(27) + "3" + Chr(27); Chr(27) + Chr(70); Chr(27) + Chr(71);
Else
Print #Arq, Chr(15)
Print #Arq, Tab(92); Chr(27) + "G"; Chr(18); Chr(27) + Chr(69); "X"; Chr(27) + "3" + Chr(27); Chr(27) + Chr(70); Chr(27) + Chr(71);
End If
Print #Arq, Chr(15)
Print #Arq, Chr(27) + "3" + Chr(20)
Print #Arq, Chr(27) + "3" + Chr(25)
Print #Arq, ""
Print #Arq, ""
Print #Arq, ""
Print #Arq, Tab(1); LerNulo(tblNota!TipoDeOperacao);
Print #Arq, Tab(40); LerNulo(tblNota!CFOP)
'
'Exit Sub
strDoc = ""
If tblCliente!TipoPessoa = "F" Then
strDoc = tblNota!CPFCliente
ElseIf tblCliente!TipoPessoa = "J" Then
strDoc = tblNota!CNPJCliente
End If
'
Print #Arq, Chr(27) + "3" + Chr(55)
Print #Arq, Tab(1); tblNota!CodigoDoCliente & " - " & tblNota!NomeDoCliente; Tab(85); strDoc; Tab(117); Format(Data_Control, "dd.mm.yyyy")
Print #Arq, Tab(1); tblNota!EnderecoCliente; Tab(67); tblNota!BairroCliente; Tab(96); LerNulo(tblNota!CEPCliente); Tab(117); Format(Data_Control, "dd.mm.yyyy")
Print #Arq, Tab(1); tblNota!CidadeCliente; Tab(50); tblNota!FoneCliente; Tab(77); LerNulo(tblNota!UF); Tab(85); LerNulo(tblNota!InscrEstCliente); Tab(117); Format(Time, "hh:mm")
Print #1, Chr(27) & "3" + Chr(30)
'listar faturas se for permitido
If blnImprimirFaturas = True Then
strSQL = ""
strSQL = strSQL & " Select FT.DataDoVencimento,FT.NumeroDaParcela,FT.VlrTotal"
strSQL = strSQL & " From Faturas FT"
strSQL = strSQL & " Where FT.NumeroDoCupom = " & CDbl(GradeSumario.TextMatrix(GradeSumario.RowSel, 1))
strSQL = strSQL & " Order By NumeroDaParcela"
If tblFaturas.State = adStateOpen Then tblFaturas.Close
tblFaturas.CursorLocation = adUseClient
tblFaturas.Open strSQL, adoBanco, adOpenForwardOnly, adLockReadOnly
If Not tblFaturas.EOF() Then
With tblFaturas
dblColNrFat = 14
dblColVencto = 18
dblColVlrTot = 36
blnImprimirNrNota = True
dblContarFaturas = 1
While Not .EOF
'imprimir so 1 vez o numero da nota
If blnImprimirNrNota Then
Print #Arq, Tab(1); Format(Mid(dblNumeroDaNota, 1, 6), "000000");
blnImprimirNrNota = False
End If
'contar numero de faturas
If dblContarFaturas = 4 Then
dblColNrFat = 14
dblColVencto = 18
dblColVlrTot = 36
End If
Print #Arq, Tab(dblColNrFat); dblContarFaturas;
Print #Arq, Tab(dblColVencto); Format(!DataDoVencimento, "dd/mm/yyyy");
Print #Arq, Tab(dblColVlrTot); AlinharLadoDireito(Format(!VlrTotal, "###0.00"), 8);
dblColVencto = dblColVencto + 40
dblColVlrTot = dblColVlrTot + 40
dblColNrFat = (dblColNrFat + 40)
dblContarFaturas = (dblContarFaturas + 1)
.MoveNext
Wend
End With
End If
Else 'se nao for permitido pular linhas
'Print #1, "" 'Chr(27) & "3" + Chr(30)
'Print #1, "" 'Chr(27) & "3" + Chr(30)
End If
'
Print #1, Chr(27) & "3" + Chr(80)
Print #1, Chr(27) & "3" + Chr(40)
'recuperar itens da nota - produtos
strSQL = ""
strSQL = strSQL & " Select CTL.CodigoDoProduto,CTL.DescricaoDoProduto,(CTL.QuantidadeDoProduto) as QuantidadeDoProduto,(CTL.ValorUnitario) AS ValorUnitario ,(CTL.ValorTotal) AS ValorTotal,ES.Unidade,(CTL.VlrISS) as VlrISS"
strSQL = strSQL & " From Contacli CTL,Estoque ES"
strSQL = strSQL & " Where CTL.NroDocNF = " & CDbl(dblNumeroDaNota)
strSQL = strSQL & " And CTL.FG_IMPRNF <> 'X'"
strSQL = strSQL & " And ES.CodigoProduto = CTL.CodigoDoProduto"
If tblProdutos.State = adStateOpen Then tblProdutos.Close
tblProdutos.CursorLocation = adUseClient
tblProdutos.Open strSQL, adoBanco, adOpenForwardOnly, adLockReadOnly
dblContaLinha = 0
dblTotalProdutos = 0
If Not tblProdutos.EOF() Then
With tblProdutos
dblContaLinha = 0
'dblVlrISS = 0
dblTotalProdutos = 0
Print #Arq, Chr(27) & "3" + Chr(35)
While Not .EOF
Print #Arq, Tab(1); Format(Mid(!CodigoDoProduto, 1, 6), "000000");
Print #Arq, Tab(12); LerNulo(!DescricaoDoProduto);
Print #Arq, Tab(81); LerNulo(!Unidade);
Print #Arq, Tab(85); AlinharLadoDireito(Format(!QuantidadeDoProduto, "###0.00"), 5);
Print #Arq, Tab(95); AlinharLadoDireito(Format((CDbl(!ValorTotal) - CDbl(!VlrISS)) / CDbl(!QuantidadeDoProduto), "###0.00"), 8);
Print #Arq, Tab(110); AlinharLadoDireito(Format(CDbl(!ValorTotal) - CDbl(!VlrISS), "###0.00"), 8);
dblTotalProdutos = dblTotalProdutos + (CDbl(!ValorTotal) - CDbl(!VlrISS))
dblContaLinha = (dblContaLinha + 1)
dblSubTotal = (dblSubTotal + CDbl(!ValorTotal))
.MoveNext
Wend
'
'verificar qtas linhas sobrou para saltar
dblNLinhasProd = (dblNLinhasProd - dblContaLinha)
If dblNLinhasProd > 0 Then
For dblPulaLinha = 1 To dblNLinhasProd
dblContaLinha = (dblContaLinha + 1)
Print #Arq, Chr(27) & "3" + Chr(35)
Next dblPulaLinha
End If
'
End With
Else
If dblNLinhasProd > 0 Then
For dblPulaLinha = 1 To dblNLinhasProd
dblContaLinha = (dblContaLinha + 1)
Print #Arq, Chr(27) & "3" + Chr(35)
Next dblPulaLinha
End If
End If
'
'recupera servicos da nota
If dblVlrISS > 0 Then
strSQL = ""
strSQL = strSQL & " Select * From NFServico"
strSQL = strSQL & " Where NumeroDaNotaFiscal = " & CDbl(dblNumeroDaNota)
If tblServicos.State = adStateOpen Then tblServicos.Close
tblServicos.CursorLocation = adUseClient
tblServicos.Open strSQL, adoBanco, adOpenForwardOnly, adLockReadOnly
If Not tblServicos.EOF() Then
With tblServicos
dblContaLinha = 0
While Not .EOF
Print #Arq, Tab(12); LerNulo(!DescricaoDoServico);
Print #Arq, Tab(85); AlinharLadoDireito(Format(!QtdServico, "###0.00"), 8);
Print #Arq, Tab(100); AlinharLadoDireito(Format(!VlrUnit, "###0.00"), 8);
Print #Arq, Tab(120); AlinharLadoDireito(Format(!VlrServico, "###0.00"), 8)
dblVlrServicos = CDbl(dblVlrServicos + !VlrServico)
dblContaLinha = (dblContaLinha + 1)
.MoveNext
Wend
'
For dblPulaLinhaServ = dblContaLinha To dblNLinhasServ
Print #Arq, Chr(27) & "3" + Chr(35)
Next dblPulaLinhaServ
'
End With
End If
Else 'ISS é zero
For dblLinha = 0 To dblNLinhasServ
Print #Arq, Chr(27) & "3" + Chr(35)
Next dblLinha
End If
Print #Arq, Tab(75); AlinharLadoDireito(Format(dblTaxaPorcISS, "###0.00"), 5) & "% - ";
Print #Arq, Tab(85); AlinharLadoDireito(Format(dblVlrISS, "###0.00"), 8);
Print #Arq, Tab(115); AlinharLadoDireito(Format(dblBaseISS, "###0.00"), 8)
'
'impostos
Print #Arq, Chr(27) + "3" + Chr(20)
Print #Arq, ""
Print #Arq, ""
Print #Arq, Tab(5); AlinharLadoDireito(Format(0, "###0.00"), 8);
Print #Arq, Tab(35); AlinharLadoDireito(Format(0, "###0.00"), 8);
Print #Arq, Tab(60); AlinharLadoDireito(Format(0, "###0.00"), 8);
Print #Arq, Tab(90); AlinharLadoDireito(Format(0, "###0.00"), 8);
Print #Arq, Tab(115); AlinharLadoDireito(Format(dblTotalProdutos, "###0.00"), 8)
'
Print #Arq, Chr(27) + "3" + Chr(20)
Print #Arq, ""
'frete
Print #Arq, Tab(5); AlinharLadoDireito(Format(dblVlrFrete, "###0.00"), 8);
Print #Arq, Tab(35); AlinharLadoDireito(Format(dblVlrSeguro, "###0.00"), 8);
Print #Arq, Tab(60); AlinharLadoDireito(Format(dblVlrDespesas, "###0.00"), 8);
Print #Arq, Tab(90); AlinharLadoDireito(Format(dblVlrIPI, "###0.00"), 8);
Print #Arq, Tab(115); AlinharLadoDireito(Format(dblVlrTotalNota, "###0.00"), 8)
'
Print #Arq, Chr(27) + "3" + Chr(15)
Print #Arq, Chr(27) + "3" + Chr(45)
Print #Arq, Tab(1); strRazaoSocial;
Print #Arq, Tab(75); strFrete; Tab(97); "SP"; Tab(105); strCNPJ;
Print #Arq, Tab(1); strEnderecoDaLoja; Tab(70); "BARRA BONITA"; Tab(97); "SP"; Tab(105); strInscricao
Print #Arq,
Print #Arq,
'observacoes
Print #Arq, Chr(27) + "3" + Chr(35)
Print #Arq, Tab(5); LerNulo(tblNota!Obs1)
Print #Arq, Tab(5); LerNulo(tblNota!Obs2)
Print #Arq, Tab(5); LerNulo(tblNota!Obs3)
Print #Arq, Tab(5); LerNulo(tblNota!Obs4)
Print #Arq, Chr(27) + "3" + Chr(43)
Print #Arq, ""
Print #Arq, ""
Print #Arq, ""
Print #Arq, Tab(118); Chr(27) + "G"; Chr(18); Chr(27) + Chr(69); Format(Mid(dblNumeroDaNota, 1, 6), "000000"); Chr(27) + "3" + Chr(27); Chr(27) + Chr(70); Chr(27) + Chr(71)
'
'atualiza tabela como nota impressa
K = " ',"
dados = ""
dados = "Update NotaFiscalCliente Set "
dados = dados & "Situacao ='" & "S" & "'"
dados = dados & " Where NumeroDaNotaFiscal = " & CDbl(dblNumeroDaNota)
dblLinhasAfetadas = 0
adoBanco.Execute (dados), dblLinhasAfetadas
If dblLinhasAfetadas = 0 Then
MsgBox "Falha na altualização de Nota Fiscal...", vbExclamation, "Aviso do Sistema..."
End If
Print #Arq, Chr(12)
Close #Arq
Next POSICAO
Screen.MousePointer = 0
ElseIf SSTab1.Tab = 1 Then 'se for Boleto
If Len(GradeFaturas.TextMatrix(GradeFaturas.Row, 1)) = 0 Then
Exit Sub
End If
'
Screen.MousePointer = 11
For POSICAO = CDbl(GradeFaturas.Row) To CDbl(GradeFaturas.RowSel)
strSQL = ""
strSQL = strSQL & " Select * From Clientes"
strSQL = strSQL & " Where CodigoDoCliente = " & CDbl(GradeSumario.TextMatrix(GradeSumario.Row, 2))
If tblCliente.State = adStateOpen Then tblCliente.Close
tblCliente.CursorLocation = adUseClient
tblCliente.Open strSQL, adoBanco, adOpenForwardOnly, adLockReadOnly
'
strDoc = ""
If tblCliente!TipoPessoa = "F" Then
strDoc = tblCliente!CPF
ElseIf tblCliente!TipoPessoa = "J" Then
strDoc = tblCliente!CNPJ
End If
'
strDataVencto = GradeFaturas.TextMatrix(POSICAO, 4)
dblTotal = GradeFaturas.TextMatrix(POSICAO, 5)
strParcela = GradeFaturas.TextMatrix(POSICAO, 8)
strNroNota = GradeFaturas.TextMatrix(POSICAO, 9)
strQtdParc = GradeFaturas.TextMatrix(POSICAO, 10)
strParcela = strNroNota & "/" & strQtdParc & "-" & strParcela
Open strImpressoraDeFormulario For Output As #Arq
Print #Arq, Chr(15)
Print #Arq, Chr(27) + "3" + Chr(0)
Print #Arq, Chr(27) & "E" 'habilitar negrito
Print #Arq, Tab(80); Chr(27) + "G"; Chr(18); Chr(27) + Chr(69); Format(strDataVencto, "dd/mm/yyyy"); Chr(27) + "3" + Chr(27); Chr(27) + Chr(70); Chr(27) + Chr(71);
Print #Arq, Chr(27) + "3" + Chr(40)
Print #Arq, Chr(15)
Print #Arq, Tab(5); Format(Data_Control, "dd/mm/yyyy");
Print #Arq, Tab(19); strParcela;
Print #Arq, Tab(35); "NF"
Print #Arq, Tab(50); Format(dblTotal, "###,###0.00")
Print #Arq, Tab(50); Format(0, "###,###0.00")
Print #Arq, Tab(50); Format(0, "###,###0.00")
Print #Arq, Tab(50); Format(0, "###,###0.00")
Print #Arq, Tab(50); Format(dblTotal, "###,###0.00")
Print #Arq, Chr(27) + "3" + Chr(40)
Print #Arq, Tab(1); tblCliente!CodigoDoCliente & " - " & tblCliente!NomeDoCliente & " " & strDoc
Print #Arq, Tab(1); tblCliente!Endereco & " " & tblCliente!Bairro & " " & LerNulo(tblCliente!CEP)
Print #Arq, Tab(1); tblCliente!cidade & " " & tblCliente!FoneResidencial & " " & LerNulo(tblCliente!UF) & " " & LerNulo(tblCliente!IE)
Close #Arq
Next POSICAO
Screen.MousePointer = 0
End If
MsgBox "Documento enviado para impressão ...", vbExclamation, "Aviso do Sistema..."
End Sub
