|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (ActiveX/Controles/DLL)
|
|
 |
Título da Dica: Enviar o conteúdo de uma listview para o excel
|
 |
|
|
|
Postada em 21/8/2006 por Felipe
puiatmp@ig.com.br
Public Sub ExportaExcel(L as Object)
Dim oExcl As Object
Dim oWrkb As Object
Dim oWrks As Object
'Dim oChrt As Object
Dim Linha As Integer
Dim Coluna As Integer
Set oExcl = CreateObject("Excel.Application")
Set oWrks = CreateObject("Excel.Sheet")
'Set oChrt = CreateObject("Excel.Chart")
Set oWrkb = oExcl.Workbooks.Add
Set oWrks = oWrkb.Worksheets(1)
oWrks.Rows(1).Font.Bold = True
For Coluna = 1 To L.ColumnHeaders.Count
oWrks.Rows(1).Cells(, Coluna).Value = L.ColumnHeaders(Coluna).Text
Next Coluna
For Linha = 1 To L.ListItems.Count
oWrks.Cells(Linha + 1, 1).Value = L.ListItems(Linha).Text
For Coluna = 2 To L.ColumnHeaders.Count
oWrks.Cells(Linha + 1, Coluna).Value = L.ListItems(Linha).SubItems(Coluna - 1)
Next Coluna
Next Linha
'Set oChrt = oWrkb.Charts.Add
'oChrt.chartType = -4100
'oChrt.HasLegend = False
'If lblBusca.Caption = "Cálculo:" Then
'oChrt.SetSourceData Source:=oWrks.Range("A1:L1:A" & Linha & ":L" & Linha), PlotBy:=2
'Else
'oChrt.SetSourceData Source:=oWrks.Range("A1:C" & Coluna & ":A1:C" & Linha), PlotBy:=2
'End If
'oChrt.Location Where:=1, Name:="Gráfico"
'oChrt.HasTitle = True
'oChrt.ChartTitle.Characters.Text = frmProcessos.Caption & " - " & cmbBusca.Text & " (" & dtpDe.Value & " - " & dtpAte.Value & ")"
'For Coluna = 1 To L.ColumnHeaders.Count
'oChrt.Axes(Coluna, 1).HasTitle = True
'oChrt.Axes(Coluna, 1).AxisTitle.Characters.Text = L.ColumnHeaders(Coluna).Text
'Next Coluna
'oChrt.HasTitle = True
'oChrt.ApplyDataLabels 2
'oWrks.Range("A:L").AutoFilter
'oWrks.Range("A:L").Columns.AutoFit
oExcl.Visible = True
oExcl.UserControl = True
Set oExcl = Nothing
Set oWrks = Nothing
'Set oChrt = Nothing
End Sub
|
|
|
|
|
