EXCEL-CABECALHO

USUARIO.EXCLUIDOS 09/07/2004 22:06:50
#32944
Olá a todos,

Estou usando a função abaixo para exportar meu banco de dados para o Excel, porém, não tenho conseguido adicionar um
cabeçalho.
Gostaria de uma ajuda para adicionar o mesmo.

Obrigado.

Private Sub Command3_Click()
Dim dbdados As Database
Dim snp As Recordset
Dim x As Integer
Dim y As Integer

x = 1

'um indicativo para nos guiar
Label2.Caption = "Inicio da operação"

Screen.MousePointer = 11

'este código usa a sintaxe do VBA

Set oleexcel = CreateObject("excel.application.8")

Set oleworkbook = oleexcel.Workbooks.Add
Set oleworksheet = oleexcel.Worksheets.Add

'atenção para o caminho do banco de dados , no seu caso deverá ser diferente
Set dbdados = DBEngine.Workspaces(0).OpenDatabase("e:\escola\escola.mdb")

'Como o nome de alguns campos possuem espaços usamos o colchetes [ ]
Set snp = dbdados.OpenRecordset("SELECT nome, sobrenome,_
cargo, FROM alunos", dbOpenSnapshot)

Label2.Caption = "Montando a planilha com dados do arquivo"

DoEvents

Do While Not snp.EOF
For y = 1 To snp.Fields.Count
oleworksheet.Cells(x, y) = snp.Fields(y - 1)
Next y

With oleworksheet.Range("A" & x)
.Value = snp.Fields(0) 'Número do empregado na colua A1-A15
.Font.Bold = True 'destaca o texto em negrito
End With

x = x + 1

snp.MoveNext
Loop

Label2.Caption = "salvando a planilha..."
DoEvents

'atenção para o path com o diretório para salvar o arquivo
oleworksheet.SaveAs "c:\escola    este.xls"
snp.Close

Screen.MousePointer = 0

oleexcel.Visible = True

Label2.Caption = "Ok !"
Label2.Caption = ""

'limpando a memoria
Set snp = Nothing
Set oleexcel = Nothing
Set oleworkbook = Nothing
Set oleworksheet = Nothing
End Sub
USUARIO.EXCLUIDOS 11/07/2004 14:38:28
#33069 Resposta escolhida
Mude para

For y = 1 To snp.Fields.Count
oleworksheet.Cells(1, y) = snp.Fields(y - 1).Name
Next y


Do While Not snp.EOF
For y = 1 To snp.Fields.Count
oleworksheet.Cells(x+1, y) = snp.Fields(y - 1)
Next y

With oleworksheet.Range("A" & x+1)
.Value = snp.Fields(0) 'Número do empregado na colua A1-A15
.Font.Bold = True 'destaca o texto em negrito
End With

x = x + 1

snp.MoveNext
Loop
Tópico encerrado , respostas não são mais permitidas
Voltar