Tenho um código para exportação de tabela do Access para o excel, utilizando o Objeto excel:
Option Explicit
Public oExcel As Object
Public objExlSht As Object
Public db As Database
Public Sn As Recordset ' Recordset do tipo Snapshot
Public Vetor() As Variant
Public row As Long, col As Long
Public fd As Field
Public Type ExlCell
row As Long
col As Long
End Type
Public Sub CopiarTabelaExcel(rs As Recordset, ws As Worksheet, StartingCell As ExlCell)
rs.MoveMax
ReDim Vetor(rs.RecordCount + 1, rs.Fields.Count)
' Copia as colunas do cabecalho para um vetor
col = 0
For Each fd In rs.Fields
Vetor(0, col) = fd.Name
col = col + 1
Next
' copia o rs par um vetor
rs.MoveMin
For row = 1 To rs.RecordCount - 1
For col = 0 To rs.Fields.Count - 1
Vetor(row, col) = rs.Fields(col).Value
'O Excel não suporta valores NULL em uma célula.
If IsNull(Vetor(row, col)) Then Vetor(row, col) = ""
Next
rs.MoveNext
Next
ws.Range(ws.Cells(StartingCell.row, StartingCell.col), ws.Cells(StartingCell.row + rs.RecordCount + 1, _
StartingCell.col + rs.Fields.Count)).Value = Vetor
End Sub
Public Sub ExportarExcellCmd()
On Error GoTo final
Dim stCell As ExlCell
frmExportar.MousePointer = 11 ' Muda o ponteiro do mouse
Set oExcel = CreateObject("Excel.Application")
oExcel.Workbooks.Add 'inclui o workbook
Set objExlSht = oExcel.ActiveWorkbook.Sheets(1)
'**************referencia da base de dados
Set db = OpenDatabase(App.Path & "BIBLIO.MDB")
Set Sn = db.OpenRecordset("Titles", dbOpenSnapshot)
'**************************************
' Inclui os dados a partir da celula A1
stCell.row = 1
stCell.col = 1
CopiarTabelaExcel Sn, objExlSht, stCell
'************** Salva a planilha
objExlSht.SaveAs App.Path & " este1.xls"
'**************************************
oExcel.Visible = True
'frmExportar.Show
frmExportar.Label1.Caption = "Encerrando o Excel"
frmExportar.Label1.Refresh
objExlSht.Application.Quit
Set objExlSht = Nothing ' remove a variavel objeto
Set oExcel = Nothing ' remove a variavel objeto
Set Sn = Nothing ' reomove a variavel objeto
Set db = Nothing ' reomove a variavel objeto
frmExportar.MousePointer = vbDefault ' Restaura o ponteiro do mouse.
frmExportar.Label1.Caption = "Muito bem, deu certo ! "
frmExportar.Label1.Refresh
MsgBox "Planilha exportada com sucesso!!", vbInformation, "Exportação!!"
Exit Sub
final:
MsgBox Err.Number & ": " & Err.Description, vbInformation, "Ocorreu um erro ao gerar a planilha excel!!"
End Sub
'--------------------------------------------------------------------
PROBLEMA: Apesar da exportação ser efetuada para a planilha do excel, os dados exportados perdem a formatação. Exemplo:
Na tabela do Access:
CodigoDocumento: "5.01" (string)
CodigoContribuinte: "1.232.010" (string)
Depois de exportado (na planilha do excel):
CodigoDocumento: 5,01 (número)
CodigoContribuinte: 1,232010 (número)
Alguém sabe como resolver isso?
valeu!!
