EXPORTAR PARA EXCEL

USUARIO.EXCLUIDOS 08/03/2005 15:29:52
#71747
Tenho um DataGrid com dados provenientes dum Ado.

Como é que eu exporto o que está no DataGrid para uma plnilha Excel??
(eu só quero exportar o que está no datagrid e não a tabela toda)


Tks.
PAULOHSV 08/03/2005 15:44:57
#71754 Resposta escolhida
M_ROGER ocodigo a seguir funciona com o MSHFlexGrid que para vc nãovaifazer diferença nenhuma ja que ambos podem ser ligados ao banco de dados

Private Sub Cmd_Exportar_Click()
Dim Lin As Integer, Col As Integer
Dim Aux As Integer
Dim Excell As Excel.Application

Set Excell = New Excel.Application

With Excell
.Visible = True ' vc pode mudar para false e o vb à± abre o excell
.Workbooks.Add ' novo arquivo

Aux = 64
For Col = 0 To Grid.Cols - 1
For Lin = 0 To Grid.Rows - 1
.Range(Chr(Aux + 1) & Trim(Str(Lin + 1))).Select 'seleciona celula
.ActiveCell.FormulaR1C1 = Grid.TextMatrix(Lin, Col) 'escreve na celula
Next Lin
Aux = Aux + 1
Next Col

ChDir "C:\Temp" 'diretorio onde vai se salvar o arquivo
.ActiveWorkbook.SaveAs FileName:="C:\Temp\Teste1.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False ' nome do arquivo a ser salvo
End With

Set Excell = Nothing
End Sub
USUARIO.EXCLUIDOS 08/03/2005 15:48:09
#71755
Ao gerar o Recordset do grid, coloque a linha

Recordset2Excel rs_fonte_do_grid

e coloque isto num módulo qualquer:


Public Sub Recordset2Excel(rstsource As ADODB.Recordset)
    Dim xlsApp As Excel.Application
    Dim xlsWBook As Excel.Workbook
    Dim xlsWSheet As Excel.Worksheet
    Dim i, j As Integer
    
    ' Get or Create Excel Object
    On Error Resume Next
    Set xlsApp = GetObject(, "Excel.Application")


    If Err.Number <> 0 Then
        Set xlsApp = New Excel.Application
            Err.Clear
    End If
    
    ' Create WorkSheet
    Set xlsWBook = xlsApp.Workbooks.Add
    Set xlsWSheet = xlsWBook.ActiveSheet
    
    ' Export ColumnHeaders


    For j = 0 To rstsource.Fields.Count
        xlsWSheet.Cells(2, j + 1) = rstsource.Fields(j).name
    Next j
    
    ' Export Data
    rstsource.MoveFirst


    For i = 1 To rstsource.RecordCount


        For j = 0 To rstsource.Fields.Count
            xlsWSheet.Cells(i + 2, j + 1) = rstsource.Fields(j).Value
        Next j
        rstsource.MoveNext
    Next i
    rstsource.MoveFirst
    ' Autofit column headers


    For i = 1 To rstsource.Fields.Count
        xlsWSheet.Columns(i).AutoFit
    Next i
    ' Move to first cell to unselect
    xlsWSheet.Range("A1").Select
    
    
    ' Show Excel
    xlsApp.Visible = True
    
    Set xlsApp = Nothing
    Set xlsWBook = Nothing
    Set xlsWSheet = Nothing
End Sub
USUARIO.EXCLUIDOS 09/03/2005 17:01:50
#71975
Obrigado aos dois.
Estou primeiro a testar a Solução do PAULOHSV

PAULOHSV, testei o seu código e dá-me erro em:

Dim Excell As Excel.Application


Pode-me dár uma ajuda ???

Tks
MS
USUARIO.EXCLUIDOS 09/03/2005 17:03:55
#71976
Vc fez referencia ao EXCEL em PROJECT /REFERENCES?
USUARIO.EXCLUIDOS 09/03/2005 18:01:25
#71996
Tem razão GERMANIR:

Mas agora dá erro nesta linha:

For Col = 0 To Grid.Cols - 1

pode-me ajudar ??

Tks.
MS
USUARIO.EXCLUIDOS 09/03/2005 18:07:49
#71999
Tente
For Col = 1 To Grid.Cols - 1
USUARIO.EXCLUIDOS 09/03/2005 18:10:55
#72004
outra coisa a propriedade NAME do seu datagrid é 'Grid' ? o nome do datagrid é 'Grid' Correto?
USUARIO.EXCLUIDOS 10/03/2005 06:19:15
#72066
GERMANAIR:
Tinhas razão, era o nome da Grid.

Agora dá erro em:

DataGrid1.TextMatrix

O que será ??

Tks.
MS
PAULOHSV 11/03/2005 08:12:51
#72263
Mas eu disse que este exemplo funciona com o MSHFlexGrid não com o DataGrid, va em componentes procure por MicrosoftHierarchicalFlexGrid ( não me lembro a escrita correta mas é algo paracido como este nome) e adicione ele ao formulario no lugar do Data Grid.
USUARIO.EXCLUIDOS 11/03/2005 15:27:59
#72411
PAULOHSV:

Você tinha razão Assim já funciona.

Só que depois de fechar o programa , se eu tentar abrir o teste1.xls, diz-me que está a ser utilizado !!!!!
Inclusivé, se tentar gravar por cima, dá erro.

Porque será ??

Tks.
Página 1 de 2 [12 registro(s)]
Tópico encerrado , respostas não são mais permitidas
Voltar