RELATORIO... COM EXPORTAR PARA UM ARQUIVO?

USUARIO.EXCLUIDOS 23/05/2007 18:04:26
#217996 Resposta escolhida

RSCaixaFechamento.Open "SELECT *From CaixaFechamento Where NArq='" & Label1 & "';", Conexao, 3, 3
Dim ClienteINI As String
NArq = Format(Now, "dd/mm/yy") & Format(Now, "hh:mm:ss")
NArq = Replace(NArq, "/", "")
NArq = Replace(NArq, ":", "")
ClienteINI = ReadINI("NomeCliente", "Cliente", App.Path & "\SIST.ini") 'Define o cliente que esta no arquivo ncs.ini
'Dim VendaDia As Currency
'VendaDia = sistema - VLRAB
Open "C:\Fechamento.doc" For Output As #1
Print #1, Chr(27) & Chr(15)
Print #1, ClienteINI
Print #1, "FECHAMENTO DETALHADO DE CAIXA"
Print #1, "Data Mov: "; RSCaixaFechamento!data; " Data Fechamento: "; RSCaixaFechamento!Hora
Print #1, "Operador: "; RSCaixaFechamento!Operador; " - Máquina: "; RSCaixaFechamento!GetName
Print #1, "";
Print #1, "*VLR DE ABERTURA*: "; Format(FormatNumber(RSCaixaFechamento!Abertura, 2), "@@@@@@@@@@@") 'ACULULADO
Print #1, ""
Print #1, "*RECEBIMENTO*"
Print #1, "DINHEIRO: "; Format(FormatNumber(RSCaixaFechamento!DinheiroRecebido, 2), "@@@@@@@@@@@")
Print #1, "CHEQUE: "; Format(FormatNumber(RSCaixaFechamento!ChequesRecebido, 2), "@@@@@@@@@@@")
Print #1, "CARTOES: "; Format(FormatNumber(RSCaixaFechamento!CartoesRecebido, 2), "@@@@@@@@@@@")
Print #1, "TOT REC: "; Format(FormatNumber(RSCaixaFechamento!VLRAtual, 2), "@@@@@@@@@@@") 'ACULULADO
Print #1, "TOT REC + ABERT: "; Format(FormatNumber(RSCaixaFechamento!TotalRecebidoAB, 2), "@@@@@@@@@@@") 'ACULULADO

Print #1, ""
Print #1, "*DETALHES RECEBIDO*"
Print #1, "LOJA: "; Format(FormatNumber(RSCaixaFechamento!Loja, 2), "@@@@@@@@@@@")
Print #1, "SERVICOS: "; Format(FormatNumber(RSCaixaFechamento!Servicos, 2), "@@@@@@@@@@@")
Print #1, "VETERINARIA: "; Format(FormatNumber(RSCaixaFechamento!Veterinaria, 2), "@@@@@@@@@@@")
Print #1, "CONTA: "; Format(FormatNumber(RSCaixaFechamento!FiadoRecebido, 2), "@@@@@@@@@@@")
Print #1, ""
Print #1, "*DECLARADOS*"
Print #1, "DINHEIRO DECLARADO:"; Format(FormatNumber(RSCaixaFechamento!DinheiroDeclarado, 2), "@@@@@@@@@@@")
Print #1, "CHEQUE DECLARADO: "; Format(FormatNumber(RSCaixaFechamento!ChequesDeclarado, 2), "@@@@@@@@@@@")
Print #1, "CARTOES DECLARADO: "; Format(FormatNumber(RSCaixaFechamento!CartoesDeclarado, 2), "@@@@@@@@@@@")
Print #1, ""
Print #1, "*RETIRADAS*"
Print #1, "DESPESAS DIVERSAS: "; Format(FormatNumber(RSCaixaFechamento!FichasDeclarado, 2), "@@@@@@@@@@@")
RSDespesas.Open "Select *from Despesas Where NArq='" & RSCaixaFechamento!NArq & "';", Conexao, 3, 3
While Not RSDespesas.EOF
'Print #1, "VLR: "; Format(FormatNumber(RSDespesas!Valor, 2), "@@@@@@@@@@@"); "DESCRICAO: "; RSDespesas!Valor
Print #1, FormatNumber(RSDespesas!Valor, 2); " - "; Left(RSDespesas!Descricao, 22)
RSDespesas.MoveNext
Wend
RSDespesas.Close
Set RSDespesas = Nothing
Print #1, ""
Print #1, "SANGRIA: "; Format(FormatNumber(RSCaixaFechamento!Sangria, 2), "@@@@@@@@@@@")
RSSangria.Open "Select *from Sangria Where NArq='" & RSCaixaFechamento!NArq & "';", Conexao, 3, 3
While Not RSSangria.EOF
'Print #1, "VLR: "; Format(FormatNumber(RSDespesas!Valor, 2), "@@@@@@@@@@@"); "DESCRICAO: "; RSDespesas!Valor
If RSSangria!Estorno = True Then
Print #1, "Est: "; FormatNumber(RSSangria!Valor, 2); " - US:"; RSSangria!Usuario; " - "; Left(RSSangria!Hora, 5)
Else
Print #1, FormatNumber(RSSangria!Valor, 2); " - US:"; RSSangria!Usuario; " - "; Left(RSSangria!Hora, 5)
End If
RSSangria.MoveNext
Wend
RSSangria.Close
Set RSSangria = Nothing
Print #1, ""
Print #1, "*******************"

If Left(RSCaixaFechamento!VlrDiferenca, 1) = "-" Then
Print #1, "*DIFERENCA:*"; Format(FormatNumber(RSCaixaFechamento!VlrDiferenca, 2), "@@@@@@@@@@@"); " FALTA"
ElseIf Left(RSCaixaFechamento!VlrDiferenca, 1) = "0" Then
Print #1, "*DIFERENCA:*"; Format(FormatNumber(RSCaixaFechamento!VlrDiferenca, 2), "@@@@@@@@@@@")
Else
Print #1, "*DIFERENCA:*"; Format(FormatNumber(RSCaixaFechamento!VlrDiferenca, 2), "@@@@@@@@@@@"); " SOBRA"
End If
Print #1, ""
Print #1, "*VENDA CONTA:* "; FormatNumber(RSCaixaFechamento!Fiado, 2) 'FIADO
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, ""
Close #1
RSCaixaFechamento.Close
Set RSCaixaFechamento = Nothing

CARINHENA 23/05/2007 18:10:21
#217997

Nil...
O problema é que eu tenho que colocar o banner no topo (no caso word) :(

Alem de tratar linha por linha...

Aguem tem algum módulo para Espaçamento?

Que ao invez de sair assim:

llllllllllll 1500
kkkkkkkkkkkkkkkkkkkkkkkkkk 1500
çççççççççççççççççççççççççççççççççç 1500

saia assim:
llllllllllll 1500
kkkkkkkkkkkkkkkkkkkkkkkkkk 1500
çççççççççççççççççççççççççççççççççç 1500

?

USUARIO.EXCLUIDOS 23/05/2007 18:45:44
#217998

On Error GoTo ERROS
Dim W1 As Word.Application
'Para criar uma nova instância do Word
Set W1 = New Word.Application

With W1
'Para o Word trabalhar visível
.Visible = True
'Para criar um novo o
.Documents.Add
'Para maximizar a tela do Word
.WindowState = wdWindowStateMaximize
.ActiveDocument.ShowGrammaticalErrors = False
'Para justificar um texto
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft

'Para digitar um texto em negrito
.Selection.Font.Bold = False
.Selection.Font.Color = wdColorBlue
.Selection.Font.Name = "Century Gothic"
.Selection.Font.Size = 18
.Selection.TypeText Text:=Label1
'Para pular uma linha
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Selection.Font.Color = wdColorBlack
.Selection.Font.Bold = True
.Selection.Font.Name = "TAHOMA"
.Selection.Font.Size = 12
.Selection.TypeText Text:=Label2 & " " & lblNOrca & " " & "Data: " & Format(DT1.Value, "dd/mm/yy")
'**************
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Selection.Font.Color = wdColorBlack
.Selection.Font.Bold = True
.Selection.Font.Name = "tahoma"
.Selection.Font.Size = 10
.Selection.TypeText Text:="De: "
.Selection.Font.Bold = False
.Selection.TypeText Text:=Trim(cboDe)
.Selection.TypeParagraph
.Selection.Font.Bold = True
.Selection.TypeText Text:="Para: "
.Selection.Font.Bold = False
.Selection.TypeText Text:=Trim(txtPara)
.Selection.TypeParagraph
.Selection.Font.Bold = True
.Selection.TypeText Text:="Empresa: "
.Selection.Font.Bold = False
.Selection.TypeText Text:=Trim(txtRazao)
.Selection.TypeParagraph
.Selection.Font.Bold = True
.Selection.TypeText Text:="TeleFax: "
.Selection.Font.Bold = False
.Selection.TypeText Text:=IIf(txtFone1 <> "", Trim(txtFone1), "") & " "
.Selection.TypeText Text:=IIf(txtFone2 <> "", Trim(txtFone2), "")
.Selection.TypeParagraph
.Selection.Font.Bold = True
.Selection.TypeText Text:="E-Mail: "
.Selection.Font.Bold = False
.Selection.TypeText Text:=Trim(txtEmail)
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText Text:="Conforme sua solicitação, informamos os valores para os artigos abaixo:"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.Font.Name = "Wingdings 3"
.Selection.Font.Bold = True
.Selection.TypeText Text:="q"
.Selection.Font.Name = "tahoma"
.Selection.TypeText Text:=" Artigo - Referencia"
.Selection.TypeText Text:=" MTs"
.Selection.TypeText Text:=" R$ Unitário"
.Selection.TypeText Text:=" R$ S.Total"
.Selection.TypeText Text:=" Desc%"
.Selection.TypeParagraph
.Selection.Font.Bold = False


Open "c:\Orçamento.txt" For Output As #1
For I = 0 To Grid1.Rows - 1
Print #1, ; Tab(1); Grid1.TextMatrix(I, 0); Tab(4); Grid1.TextMatrix(I, 1); Tab(32); Grid1.TextMatrix(I, 2); Tab(38); Format$(Grid1.TextMatrix(I, 3), "@@@@@@@@@@@"); Tab(51); Format$(Grid1.TextMatrix(I, 4), "@@@@@@@@@@@"); Tab(67); Format(Grid1.TextMatrix(I, 5), "@@")
Next
Close #1
.Selection.InsertFile "c:\Orçamento.txt"
.Selection.TypeParagraph
.Selection.TypeParagraph
'.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
.Selection.Font.Bold = True
.Selection.TypeText Text:=" R$ Total: "
.Selection.TypeText Text:=Format(txtTotal, "@@@@@@@@@@@")
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.Font.Bold = True
.Selection.TypeText Text:="Prazo de Pagamento: "
.Selection.Font.Bold = False
.Selection.TypeText Text:=cboPagamento
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Selection.TypeText Text:="_______________________________________________________________________________"
'.Selection.InsertDateTime
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Selection.Font.Bold = True
.Selection.TypeText Text:="ENVIAR REMESSA BANCÁRIA:"
.Selection.TypeParagraph
.Selection.Font.Bold = False
.Selection.TypeText Text:="EMPRESA LTDA."
.Selection.TypeParagraph
.Selection.TypeText Text:="CNPJ: 20.280.666/0001-41"
.Selection.TypeParagraph
.Selection.TypeText Text:="BANCO BRADESCO S/A"
.Selection.TypeParagraph
.Selection.TypeText Text:="AG 9183-8"
.Selection.TypeParagraph
.Selection.TypeText Text:="C/C 54415-7"
.Selection.TypeParagraph
.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Selection.TypeText Text:="_______________________________________________________________________________"

.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.Font.Bold = True
.Selection.Font.Color = wdColorBlue
.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Selection.TypeText Text:="AO ENVIAR REMESSA BANCÁRIA, FAVOR CONFIRMAR VIA FAX Nº"
.Selection.TypeParagraph
.Selection.TypeText Text:="(11) 9488-7988 OU E-MAIL sac@empresa.com.br"
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.Font.Color = wdColorBlack
.Selection.Font.Size = 13
.Selection.TypeText Text:="ATENÇÃO PARA NOSSO NOVO ENDEREÇO:"
.Selection.TypeParagraph
.Selection.Font.Bold = False
.Selection.Font.Size = 8
.Selection.Font.Color = wdColorBlue
.Selection.TypeText Text:="Empresa Ltda."
.Selection.TypeParagraph
.Selection.TypeText Text:="Rua da Empresa, 372 - Bairro - São Paulo - SP - 05415-040"
.Selection.TypeParagraph
.Selection.TypeText Text:="Fone/Fax: (11) 3087 - 7300"
.Selection.TypeParagraph
.Selection.TypeText Text:="www.empresa.com.br"




'Para salvar o arquivo criado
.ActiveDocument.SaveAs "c:\Orçamento.doc"
'.ActiveDocument.Close
'Para fechar o o criado
'.Documents(W1.Active).Close
End With
Set W1 = Nothing
ERROS:
If Err Then
MSGERROS
End If

Olha pode ser até que não seja bem isso que vc quer, mas modestia parte
esse codigo é uma joia rara.

Guarde para quando precisar.

Obs: o arquivo texto entra na jogada para alinhar os valores monetarios
e os dados que estão em um grid.

ele é criado e depois é inserido no word.

Bolei essa pois não encontrei nada igual .