Tenho uma rotina que exporta os dados de livros para o Excel. Acontece que quando o campo "Observação" no sistema é muito grande (com muitos caracteres) a celula na planilha Excel gerada pelo sistema fica com este simbolo: #VALOR!
Alguém sabe por que isso acontece?
Vejam a rotina abaixo:
Sub ExportaExcel()
'On Error GoTo ERRO
Dim Plan As Object
Dim contador As Long
'Monta consulta sql selecionando os dados necessários
Set rsTabela = db.OpenRecordset("SELECT tblCadProd.Autor, " _
& "tblCadProd.DescricaoProduto, tblCadProd.Editora, tblCadProd.Ano, " _
& "tblCadProd.Assunto, tblCadProd.PrecoVenda, tblCadProd.PrecoVendaNovo, " _
& "tblCadProd.Observacao, tblCadProd.QuantidadeEstoque, " _
& "tblCadProd.QuantidadeEstoqueNovo, tblCadProd.CodigoBarras, " _
& "tblCadProd.Peso, tblCadProd.Setor, " _
& "[tblCadProd]![PrecoVenda]+[tblCadProd]![PrecoVendaNovo] AS SomaPreco, " _
& "[tblCadProd]![QuantidadeEstoque]+[tblCadProd]![QuantidadeEstoqueNovo] " _
& "AS SomaQuantidade from tblCadProd Where (((tblCadProd.Autor) <> '') " _
& "And ((tblCadProd.DescricaoProduto) <> '') And ((tblCadProd.Editora) <> '') " _
& "And ((tblCadProd.Setor) <> '') And ((tblCadProd.Ano) <> '') " _
& "And (([tblCadProd]![PrecoVenda] + [tblCadProd]![PrecoVendaNovo]) > 0) " _
& "And (([tblCadProd]![QuantidadeEstoque] + [tblCadProd]![QuantidadeEstoqueNovo]) > 0)) " _
& "ORDER BY tblCadProd.DescricaoProduto;")
If rsTabela.EOF = False And rsTabela.BOF = False Then
'Verifica se o arquivo de modelo do Excel existe
If Existe(App.Path & "TextoTabela_de_Produtos.xls") Then
Set Plan = CreateObject("Excel.Application")
Plan.Workbooks.Open App.Path & "TextoTabela_de_Produtos.xls"
With Plan
.Range("a2:IV65000").ClearContents
.Range("A1").value = "Autor"
.Range("B1").value = "Título"
.Range("C1").value = "Editora"
.Range("D1").value = "Ano"
.Range("E1").value = "Estante"
.Range("F1").value = "Preço"
.Range("G1").value = "Descrição"
.Range("H1").value = "Peso"
.Range("I1").value = "Meta-prateleira"
'Configura a barra de progresso
frmProgresso.prbProgresso.Min = 0
frmProgresso.prbProgresso.Max = rsTabela.RecordCount
i = 2
Do While rsTabela.EOF = False
'Incrementa a barra de progresso do
'form 'frmProgresso'
frmProgresso.prbProgresso.value = rsTabela.AbsolutePosition
'Coloca o nome dos regsitros na label de progresso
frmProgresso.lblProgresso.Caption = rsTabela!DescricaoProduto
'Exporta os registros na tabela
If rsTabela!PrecoVenda <> "0" And rsTabela!PrecoVenda <> "R$ 0,00" And rsTabela!PrecoVenda <> "0,00" And rsTabela!QuantidadeEstoque > 0 Then
.Cells(i, 1) = rsTabela!Autor
.Cells(i, 2) = rsTabela!DescricaoProduto
.Cells(i, 3) = rsTabela!Editora
.Cells(i, 4) = rsTabela!Ano
.Cells(i, 5) = rsTabela!Setor
.Cells(i, 6) = rsTabela!PrecoVenda
.Cells(i, 7) = rsTabela!Observacao
.Cells(i, 8) = rsTabela!Peso
.Cells(i, 9) = rsTabela!Assunto
.Cells(i, 10) = " "
i = i + 1
contador = contador + 1
End If
If rsTabela!PrecoVendaNovo <> "0" And rsTabela!PrecoVendaNovo <> "R$ 0,00" And rsTabela!PrecoVendaNovo <> "0,00" And rsTabela!QuantidadeEstoqueNovo > 0 Then
.Cells(i, 1) = rsTabela!Autor
.Cells(i, 2) = rsTabela!DescricaoProduto
.Cells(i, 3) = rsTabela!Editora
.Cells(i, 4) = rsTabela!Ano
.Cells(i, 5) = rsTabela!Setor
.Cells(i, 6) = rsTabela!PrecoVendaNovo
.Cells(i, 7) = rsTabela!Observacao
.Cells(i, 8) = rsTabela!Peso
.Cells(i, 9) = rsTabela!Assunto
.Cells(i, 10) = " "
i = i + 1
contador = contador + 1
End If
rsTabela.MoveNext
Loop
End With
'Fecha o form de progresso
Unload frmProgresso
'Salva os dados na planilha
Plan.ActiveWorkbook.SaveAs FileName:="C:SGITextoTabela_de_Produtos.xls"
Plan.ActiveWorkbook.Close SaveChanges:=False
Plan.Quit
Set Plan = Nothing
Else
Beep
MsgBox "Arquivo modelo do Excel não foi localizado para que os registros " & vbCrLf & " sejam exportados.", vbCritical, "Aviso"
Exit Sub
End If
'Envia mensagem ao usuário do número de produtos exportados
If MsgBox("Arquivo gerado com sucesso: " & vbCrLf & vbCrLf & "Nome do arquivo: " & "Tabela_de_Produtos.xls" & vbCrLf & "Local de gravação: " & App.Path & "Texto" & vbCrLf & "Total de registros exportados: " & contador & vbCrLf & vbCrLf & "Deseja abrir a pasta onde foi criado o arquivo ?", vbInformation + vbYesNo, "SGI") = vbYes Then
WinExec "Explorer.exe C:SGITexto", 10
End If
Else
'Fecha a tela de progresso
Unload frmProgresso
'Envia mensagem ao usuário
Beep
MsgBox "Não existem registros para serem exportados. No momento do " _
& "cadastro de livros os seguintes campos tem que ser preenchidos " _
& "para que o registro seja exportado: " & vbCrLf & vbCrLf & "1) Título" & vbCrLf & "2) Autor" & vbCrLf & "3) Editora" & vbCrLf & "4) Assunto" & vbCrLf & "5) Preço" & vbCrLf & "6) Ano" & vbCrLf & "7) O campo 'Quantidade atual em estoque' tem que ser maior ou igual a 1", vbExclamation, "SGI"
End If
'Plan.Visible = True
'Plan.UserControl = False
Exit Sub
ERRO:
'Grava o erro em um arquivo texto "c:siferror.log"
GravaErro Err.Number, Err.Description, Err.Source, Now, "Controle de Estoque", App.Path & "Error.log"
Select Case Err
Case 70
Beep
MsgBox "Você está com a planilha de produtos aberta, feche-a" & vbCrLf & "antes de exportar a tabela de produtos.", vbCritical, "Aviso"
Exit Sub
Case 76
'Caso o diretorio 'Texto' não exista então cria
MkDir App.Path & "Texto"
Resume
Case 1004
Beep
MsgBox "Os registros não foram exportados para o arquivo, caso" & vbCrLf & "não seja você quem interrompeu a exportação feche o" & vbCrLf & "SGI reinicie seu computador e tente novamente.", vbExclamation, "Aviso"
Case Else
MsgBox "Erro número #" & Str$(Err.Number) & " na Linha " & Str$(Erl) & " - " _
& Err.Description & " - gerado por " & Err.Source, vbCritical
Exit Sub
End Select
End Sub
