EXPORTAR DADOS MSFLEXGRID PARA EXCEL

CHMATOS 07/08/2011 10:52:38
#380995

O problema é que tenho uma grade com mais de 2 colunas e cada relatório possui uma quantidade de colunas diferentes.

LUIS.HERRERA 13/08/2011 10:23:34
#381643 Resposta escolhida

Isso eu peguei de algum lugar e adaptei. Ele exporta todas as colunas visíveis no Flexgrid, se quiser as invisíveis também, se tiver, tem que adaptar.

Num módulo BAS coloca

[ô] *********** Exporta Grid para Excel ***********
Public Sub ExportaGrid(ByRef MyGrid As MSFlexGrid, ByVal sCabecalho As String, Optional sLegenda As String)
10 On Error GoTo Falha

Dim oExcel As Object
Dim oSheet As Object
Dim oBook As Object
Dim i As Long
Dim J As Long
Dim iLinhaInicialDados As Integer
Dim strNomeFormMod As String
Dim descErro As String

20 strNomeFormMod = [Ô]modExportaGridExcel[Ô]
30 descErro = [Ô]Cria Objeto Excel[Ô]

[ô] Verifica se existe dados no grid para continuar
40 If MyGrid.Rows < 2 Then
[ô]50 MeuAlerta [Ô]Não existem registros na grade para exportar.[Ô], Informacao
60 GoTo Saida
70 End If
[ô]usa a versão do execel do usuário, por isso não existe referência no projeto só aqui
80 Set oExcel = CreateObject([Ô]Excel.Application[Ô])
90 Set oBook = oExcel.Workbooks.Add
[ô] Cria nova planilha na pasta
[ô]Set oSheet = oExcel.Workbooks(1).Worksheets.Add
[ô] Abre planilha existente
100 Set oSheet = oBook.Worksheets.Item(1)
110 iLinhaInicialDados = 3

[ô] 1ª linha título colunas e demais dados do grid
120 descErro = [Ô]Povoa Planilha do Excel[Ô]
130 For i = 0 To MyGrid.Rows - 1
140 For J = 1 To MyGrid.Cols
150 If MyGrid.ColWidth(J - 1) > 0 Then
160 Select Case MyGrid.TextMatrix(i, J - 1)
Case Chr(252)
170 oSheet.cells(iLinhaInicialDados + i, J).Value2 = [Ô]Sim[Ô]
180 Case Chr(253)
190 oSheet.cells(iLinhaInicialDados + i, J).Value2 = [Ô]Cancelado[Ô]
200 Case Else
210 oSheet.cells(iLinhaInicialDados + i, J).Value2 = MyGrid.TextMatrix(i, J - 1)
220 End Select
230 End If
240 Next J
250 Next i

260 descErro = [Ô]Exclui colunas vazias do grid no Excel[Ô]
270 For J = MyGrid.Cols To 1 Step -1
280 If MyGrid.ColWidth(J - 1) = 0 Then
290 oSheet.Columns(J).Select
[ô]oExcel.Selection.EntireColumn.Hidden = True [ô]oculta coluna, mas não deixa aplicar formatação
300 oExcel.Selection.Delete
310 End If
320 Next J
330 oExcel.cells(1, 1).Select
340 descErro = [Ô]Formata Planilha do Excel[Ô]
350 oExcel.ActiveCell.Worksheet.cells(iLinhaInicialDados, 1).AutoFormat

[ô] Inclui legenda se houver
360 descErro = [Ô]Inclui Legenda no Excel[Ô]
370 If Len(sLegenda) > 0 Then
380 oSheet.cells(iLinhaInicialDados + i + 1, 1).Value2 = sLegenda
390 End If

[ô]Configura cabeçalho
400 descErro = [Ô]Configura Cabeçalho da Planilha no Excel[Ô]
410 With oSheet
[ô] *** Imprime o cabeçalho da planilha na linha 1 e coluna 3 ***
420 .cells(1, 2).Value = sCabecalho
430 .cells(1, 2).Font.Name = [Ô]Verdana[Ô]
440 .cells(1, 2).Font.Bold = True
450 End With

[ô]# Exibe a planilha preenchida
460 descErro = [Ô]Exibe Planilha do Excel[Ô]
470 oExcel.Visible = True

Saida:
480 descErro = vbNullString
490 Set oExcel = Nothing
500 Set oSheet = Nothing
510 Set oBook = Nothing
520 Exit Sub

Falha:
530 If Err.Number = 429 Then
[ô]minha rotina personalizada para exibir mensagens
[ô]540 MeuAlerta [Ô]Não existe o programa MSExcel instalado em seu micro.[Ô] & vbNewLine & [Ô]Não foi possível exportar os dados.[Ô], Informacao
550 On Error GoTo 0
560 Resume Saida
[ô]minha rotina avisar sobre erro do sistema
[ô]570 ElseIf OutPutErr(strNomeFormMod, [Ô]ExportaGrid[Ô], Erl, Err.Number, Err.Description, descErro) = False Then
[ô]580 MeuAlerta sMsgErroHC, Informacao
590 End If
600 On Error GoTo 0
610 Resume Saida
End Sub
[ô] ********** Fim exporta grid ************

Agora no botão que vai exporta no form

Private Sub cmdExcel_Click()
ExportaGrid GridDoc, [Ô]Lista de Documentos[Ô], [Ô]Legenda Origem: (I) Internos; (E) Externos[Ô]
End Sub