EXPORTACAO PARA O EXCEL
Galera estou exportando os dados de um conhecimento para um romaneio e no excel todos os dados estão certinho, menos o campo de obs do conhecimento, que acaba saindo conforme a figura, ao invés dele ultrapassar a célula igual os outros compos, ele obedece o tamanho da coluna e vai jogando o texto para baixo.
Será que alguém pode me dar uma luz do que esta acontecendo?
Segue abaixo os comandos para fazer a exportação para o excel, más o problema como já comentei, está somente ao exportar campo observação, nos demais campos, tudo é preeenchido corretamente
Dim I As Integer
Dim ObjPicture As Picture
Dim RemententeDestinatario As String * 30
Dim EnderecoEntregaColeta() As String, NNotasFiscaisSelecionadas() As String
Set Rs = New ADODB.Recordset
strSQL = [Ô]select logo from parametros[Ô]
Rs.Open strSQL, Db, adOpenKeyset, adLockPessimistic
If Dir(App.Path & [Ô]\Romaneio.xls[Ô]) <> [Ô][Ô] Then Kill (App.Path & [Ô]omaneio.xls[Ô]) [ô]Se o arquivo já existir apagar ele
Set AExcel = CreateObject([Ô]Excel.Application[Ô]) [ô]Criar nova aplicação do Excel
Set WExcel = AExcel.Workbooks.Add [ô]Cria um arquivo xls
Set SExcel = WExcel.Sheets(1) [ô]Direciona os dados para planilha 1, seja lá qual for o nome dela
Set fSheet = AExcel.ActiveWorkbook.ActiveSheet [ô]Defina a planilha ativa p/ facilitar o trabalho:
fSheet.PageSetup.Orientation = xlLandscape
fSheet.Shapes.AddPicture Rs(0), True, True, 1, 1, 215, 40
fSheet.Cells.Font.Size = 8
fSheet.Cells.Font.Bold = True
fSheet.PageSetup.LeftMargin = 1
fSheet.PageSetup.RightMargin = 0
fSheet.Cells(1, 6) = [Ô]ALCANCE TRANSPORTES RODOVIÃRIOS ESPECIALIZADOS LTDA[Ô]
fSheet.Cells(2, 6) = [Ô]Matriz: Rua Ushikichi Kamiya, 50-B, Vila Airosa, KM 83 - Rod Fernão Dias[Ô]
fSheet.Cells(3, 6) = [Ô]São Paulo - SP - CEP 02323-000 - Tel/Fax: (11) 2995-7237 - Sede Própria[Ô]
fSheet.Cells(4, 6) = [Ô]www.advanceexpress.net - advance@advanceexpress.net[Ô]
fSheet.Cells(6, 1) = String(240, [Ô]-[Ô])
fSheet.Cells(8, 5) = [Ô]Manifesto de Transporte de Carga Rodoviária[Ô]
fSheet.Cells(10, 1) = [Ô]Romaneio Nº [Ô] & LblNRomaneio.Caption
fSheet.Cells(11, 1) = [Ô]Emissão - [Ô] & Date
fSheet.Cells(13, 1) = [Ô]Motorista:[Ô] & LstInclusaoCtrc.ListItems(1).ListSubItems(10)
fSheet.Cells(13, 7) = [Ô]VeÃculo:[Ô] & LstInclusaoCtrc.ListItems(1).ListSubItems(11)
fSheet.Cells(15, 1) = [Ô]Procedência:[Ô] & TxtProcedencia.Text
fSheet.Cells(15, 7) = [Ô]Destino: [Ô] & TxtDestino.Text
fSheet.Cells(17, 1) = [Ô]CTRC[Ô]
fSheet.Cells(17, 2) = [Ô]REMETENTE[Ô]
fSheet.Cells(17, 3) = [Ô]CIDADE[Ô]
fSheet.Cells(17, 4) = [Ô]DESTINATARIO[Ô]
fSheet.Cells(17, 5) = [Ô]CIDADE[Ô]
fSheet.Cells(17, 6) = [Ô]QTE[Ô]
fSheet.Cells(17, 7) = [Ô]PESO[Ô]
fSheet.Cells(17, 8) = [Ô]N.FISCAL[Ô]
fSheet.Cells(17, 9) = [Ô]VALOR NF[Ô]
[ô] WExcel.Close True, App.Path & [Ô]omaneio.xls[Ô] [ô]Autoriza salvar e endereço do arquivo
[ô] Set WExcel = AExcel.Workbooks.Open(App.Path & [Ô]omaneio.xls[Ô])
[ô] Set SExcel = WExcel.Sheets(1)
[ô]Variáveis para totalizar
Dim Qte, ValorTotal, Peso
Qte = 0
ValorTotal = 0
Peso = 0
On Error Resume Next
[ô]Caso de algum erro para carregar o endereço de entrega e coleta antigo
With fSheet
For I = 1 To LstInclusaoCtrc.ListItems.Count
.Cells(I + 17, 1) = LstInclusaoCtrc.ListItems(I).ListSubItems(1)
RemententeDestinatario = LstInclusaoCtrc.ListItems(I).ListSubItems(2)
.Cells(I + 17, 2) = RemententeDestinatario
EnderecoEntregaColeta = Split(LstInclusaoCtrc.ListItems(I).ListSubItems(3), [Ô]-[Ô])
.Cells(I + 17, 3) = EnderecoEntregaColeta(2)
RemententeDestinatario = LstInclusaoCtrc.ListItems(I).ListSubItems(4)
.Cells(I + 17, 4) = RemententeDestinatario
EnderecoEntregaColeta = Split(LstInclusaoCtrc.ListItems(I).ListSubItems(5), [Ô]-[Ô])
.Cells(I + 17, 5) = EnderecoEntregaColeta(2)
.Cells(I + 17, 6) = LstInclusaoCtrc.ListItems(I).ListSubItems(6)
.Cells(I + 17, 7) = LstInclusaoCtrc.ListItems(I).ListSubItems(7)
If Replace(LstInclusaoCtrc.ListItems(I).ListSubItems(8), [Ô].[Ô], [Ô][Ô]) = [Ô]VIDE OBS[Ô] Then
NNotasFiscaisSelecionadas = Split(UCase(LstInclusaoCtrc.ListItems(I).ListSubItems(12)), [Ô]NF(S):[Ô])
.Cells(I + 17, 8) = [Ô]***[Ô]
Else
.Cells(I + 17, 8) = LstInclusaoCtrc.ListItems(I).ListSubItems(8)
End If
.Cells(I + 17, 9) = Format(LstInclusaoCtrc.ListItems(I).ListSubItems(9), [Ô]###,###,##0.00[Ô])
If Replace(LstInclusaoCtrc.ListItems(I).ListSubItems(8), [Ô].[Ô], [Ô][Ô]) = [Ô]VIDE OBS[Ô] Then
NNotasFiscaisSelecionadas = Split(NNotasFiscaisSelecionadas(1), Chr(13))
.Cells(I + 17, 10) = [Ô]*** NF(s): [Ô] & NNotasFiscaisSelecionadas(0)
End If
Qte = Qte + LstInclusaoCtrc.ListItems(I).ListSubItems(6)
ValorTotal = ValorTotal + LstInclusaoCtrc.ListItems(I).ListSubItems(9)
Peso = Peso + LstInclusaoCtrc.ListItems(I).ListSubItems(7)
Next
End With
fSheet.Cells(I + 19, 1) = [Ô]TOTAL GERAL [Ô] & Chr(13) & [Ô]DO ROMANEIO[Ô]
fSheet.Cells(I + 19, 6) = Qte
fSheet.Cells(I + 19, 7) = Peso
fSheet.Cells(I + 19, 9) = Format(ValorTotal, [Ô]###,###,##0.00[Ô])
fSheet.Cells(I + 22, 1) = txtObs.Text
Abraço e obrigado
Alguém pode me dar uma luz ?!
Não consegui ver a imagem porque ela está hospedada em um servidor que para mim é bloqueado para acesso. Coloque a figura no corpo da mensagem.
Alexandre
Alexandre
Segue a imagem
[Ô]... [txt-color=#e80000].Cells(I + 17, 10) = [Ô]*** NF(s): [Ô] & NNotasFiscaisSelecionadas(0)[/txt-color][Ô] Acredito que seja porque você está concatenando (&) o tÃtulo [Ô]*** NF(s): [Ô] com o valor que a célula deve receber, que é [Ô]NNotasFiscaisSelecionadas(0)[Ô]. Note que para os outros campos (remetente, cidade, destinatário, etc.) você usa o [Ô]LstInclusaoCtrc...[Ô].
Defina o nome do campo da mesma forma que você definiu para remetente, destinatário, cidade, etc:
Por exemplo:
[Ô]
...
fSheet.Cells(17, 1) = [Ô]CTRC[Ô]
fSheet.Cells(17, 2) = [Ô]REMETENTE[Ô]
fSheet.Cells(17, 3) = [Ô]CIDADE[Ô]
fSheet.Cells(17, 4) = [Ô]DESTINATARIO[Ô]
fSheet.Cells(17, 5) = [Ô]CIDADE[Ô]
fSheet.Cells(17, 6) = [Ô]QTE[Ô]
fSheet.Cells(17, 7) = [Ô]PESO[Ô]
fSheet.Cells(17, 8) = [Ô]N.FISCAL[Ô]
fSheet.Cells(17, 9) = [Ô]VALOR NF[Ô]
[txt-color=#e80000]fSheet.Cells(17,10) = [Ô]*** NF(s):[/txt-color][Ô]
...
[Ô]
Talvez seja isso...
Alexandre
Defina o nome do campo da mesma forma que você definiu para remetente, destinatário, cidade, etc:
Por exemplo:
[Ô]
...
fSheet.Cells(17, 1) = [Ô]CTRC[Ô]
fSheet.Cells(17, 2) = [Ô]REMETENTE[Ô]
fSheet.Cells(17, 3) = [Ô]CIDADE[Ô]
fSheet.Cells(17, 4) = [Ô]DESTINATARIO[Ô]
fSheet.Cells(17, 5) = [Ô]CIDADE[Ô]
fSheet.Cells(17, 6) = [Ô]QTE[Ô]
fSheet.Cells(17, 7) = [Ô]PESO[Ô]
fSheet.Cells(17, 8) = [Ô]N.FISCAL[Ô]
fSheet.Cells(17, 9) = [Ô]VALOR NF[Ô]
[txt-color=#e80000]fSheet.Cells(17,10) = [Ô]*** NF(s):[/txt-color][Ô]
...
[Ô]
Talvez seja isso...
Alexandre
Alexandre eu ja tinha feito isso tb, e deu a mesma coisa, eu criei uma string para poder separar o texto que estava na obs do conhecimento e infelizmente deu a mesma coisa.
O que eu fiz foi criar uma string más tb não deu certo
O que eu fiz foi criar uma string más tb não deu certo
Alguém ...
Barros obrigado pelo retorno
Barros eu acabei de colocar esse comando para poder testar e infelizmente não deu certo, e quanto aos caracteres especiais, vc tem razão é para pular linha mesmo , pois esse é um campo de observação onde o usuário pode colocar alguma coisas, e é exatamente ele que esta dando esse erro, pois peguei uma observação e coloquei um texto grande sem o enter e ele ficou em uma linha normal, quando coloquei o enter, mesmo em um texto pequeno aconteceu isso que esta na figura, eu enquanto estava dando o retorno para você quanto ao comando citado, eu bolei um jeito que acho que pode dar certo, o problema do split e que não deu certo, é que eu mantive tudo de uma mesma célula, agora o que farei é fazer esse split e a cada enter mudar de linha, acho que com isso posso resolver esse problema.
Barros será que você ou mais alguém tem alguma idéia melhor que a minha para tentar resolver esse problema?
Barros eu acabei de colocar esse comando para poder testar e infelizmente não deu certo, e quanto aos caracteres especiais, vc tem razão é para pular linha mesmo , pois esse é um campo de observação onde o usuário pode colocar alguma coisas, e é exatamente ele que esta dando esse erro, pois peguei uma observação e coloquei um texto grande sem o enter e ele ficou em uma linha normal, quando coloquei o enter, mesmo em um texto pequeno aconteceu isso que esta na figura, eu enquanto estava dando o retorno para você quanto ao comando citado, eu bolei um jeito que acho que pode dar certo, o problema do split e que não deu certo, é que eu mantive tudo de uma mesma célula, agora o que farei é fazer esse split e a cada enter mudar de linha, acho que com isso posso resolver esse problema.
Barros será que você ou mais alguém tem alguma idéia melhor que a minha para tentar resolver esse problema?
Galera infelizmente não deu certo minha idéia, por causa que o split não esta tirando o salto de linha, apesar de eu pedir para ele separar pelo salto de linha, o texto esta assim:
No meu TXTOBS.TEXT
LOCAL DE ENTREGA: IMPLANTECH - RUAJOSé JORGE PEREIRA, QUADRA D LOTE 6 GALPÃO 12 CONDOMÃNIO MÓDULO -
BAIRRO BURAQUINHO - LAURO DE FREITAS - BA.
CONTATO: MAURO ADEGAS (71) 9203-0636 / (71) 3379-3603
E esse é o comando que coloquei para pegar o texto e dar um split no enter e depois jogar tudo em uma linha só, terminando o meu problema
Dim J, Obs2, Obs() As String
Obs = Split(txtObs.Text, Chr(13))
Obs2 = [Ô][Ô]
On Error Resume Next
For J = 0 To 100
Obs2 = Obs2 & Trim(Obs(J)) & [Ô] [Ô]
Next
fSheet.Cells(i + 20, 2) = Obs2
Só que ao invés do obs(0) estar com o conteúdo, após o split,
LOCAL DE ENTREGA: IMPLANTECH - RUAJOSé JORGE PEREIRA, QUADRA D LOTE 6 GALPÃO 12 CONDOMÃNIO MÓDULO -
Ele esta assim
LOCAL DE ENTREGA: IMPLANTECH - RUAJOSé JORGE PEREIRA, QUADRA D LOTE 6 GALPÃO 12 CONDOMÃNIO MÓDULO -
Ele tem esse enter antes da frase e já tentei tirar ele dando o replace na variável
trim(replace(obs(J),chr(13),[Ô] [Ô]))
Más ficou na mesma, ele não faz a separação, será que alguém pode me ajudar
Abraço e obrigado até o momento
No meu TXTOBS.TEXT
LOCAL DE ENTREGA: IMPLANTECH - RUAJOSé JORGE PEREIRA, QUADRA D LOTE 6 GALPÃO 12 CONDOMÃNIO MÓDULO -
BAIRRO BURAQUINHO - LAURO DE FREITAS - BA.
CONTATO: MAURO ADEGAS (71) 9203-0636 / (71) 3379-3603
E esse é o comando que coloquei para pegar o texto e dar um split no enter e depois jogar tudo em uma linha só, terminando o meu problema
Dim J, Obs2, Obs() As String
Obs = Split(txtObs.Text, Chr(13))
Obs2 = [Ô][Ô]
On Error Resume Next
For J = 0 To 100
Obs2 = Obs2 & Trim(Obs(J)) & [Ô] [Ô]
Next
fSheet.Cells(i + 20, 2) = Obs2
Só que ao invés do obs(0) estar com o conteúdo, após o split,
LOCAL DE ENTREGA: IMPLANTECH - RUAJOSé JORGE PEREIRA, QUADRA D LOTE 6 GALPÃO 12 CONDOMÃNIO MÓDULO -
Ele esta assim
LOCAL DE ENTREGA: IMPLANTECH - RUAJOSé JORGE PEREIRA, QUADRA D LOTE 6 GALPÃO 12 CONDOMÃNIO MÓDULO -
Ele tem esse enter antes da frase e já tentei tirar ele dando o replace na variável
trim(replace(obs(J),chr(13),[Ô] [Ô]))
Más ficou na mesma, ele não faz a separação, será que alguém pode me ajudar
Abraço e obrigado até o momento
Alguém ...
Tópico encerrado , respostas não são mais permitidas