iMasters | Por uma internet mais criativa e dinâmica

strArquivo = "dados.mdb"
strLocal = App.Path
Set cn = CreateObject("ADODB.Connection")
Conecta = "Driver={Microsoft Access Driver (*.mdb)};" & _
"Dbq=" & strArquivo & ";" & _
"DefaultDir=" & strLocal & ";" & _
"Uid=Admin;Pwd=;"

cn.Open Conecta

Load frmDados
frmDados.Show
End Sub

Para este exemplo, é preciso fazer referência ao ADO para usar a conexão com o banco de dados e Microsoft Excel e exportar os dados, como mostra a figura abaixo:

Voltando ao form frmDados modele-o como mostra a figura abaixo:

Para incluir o ListView e o Chart(Gráfico), no menu principal, clique em Project/Components e selecione os itens Microsoft Chart Control 6.0 e Microsoft Windows Common Control 6.0, como mostra a figura abaixo:

Na barra de componente, dê um duplo clique em ListView, como mostra a figura abaixo:

Selecione o ListView que acabou de inserir, vá em properties e renomeie para lstAgenda, como mostra a figura abaixo:

Clique em Custom, e, em Column Headers, crie 6 campos: Mês, Valor1, Valor2, Valor3, Valor4 e Valor5, como mostra a figura abaixo:

Codifique o frmDados da seguinte forma:

Private Sub Form_Load()
Call montaLista
End Sub

Private Sub cmdExcel_Click()
Dim i, n, col, lin As Long
Dim objExcel As Excel.Application
Dim objWorkbook As Excel.Workbook

On Error Resume Next

Set objExcel = New Excel.Application
Set objExcel = GetObject(, "Excel.Application")
If Err.Number Then
Err.Clear
Set objExcel = CreateObject("Excel.Application")
If Err.Number Then
MsgBox "Não foi possivel abrir o Excel."
End If
End If
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add

rs.Open "select * from mes", cn, adOpenKeyset, adLockOptimistic
'--- conta as linhas ---
Do While Not rs.EOF
lin = lin + 1
rs.MoveNext
Loop

'--- conta as colunas ---
col = rs.Fields.Count

For i = 0 To 0
For n = 0 To col - 1
objWorkbook.ActiveSheet.Cells(i + 1, n + 1).Value = rs.Fields(n).Name
Next
Next

rs.MoveFirst ' move para o primeiro registro
For i = 1 To lin
For n = 0 To col - 1
objWorkbook.ActiveSheet.Cells(i + 1, n + 1).Value = rs.Fields(n).Value
Next
rs.MoveNext
Next

rs.Close
Set objWorkbook = Nothing
Set objExcel = Nothing
End Sub

Private Sub cmdGrafico_Click()
frmGrafico.Show
End Sub

Private Sub cmdSair_Click()
Unload Me
End Sub

Private Sub montaLista()
Dim lst As ListItem
'Limpar Lista
ListView1.ListItems.Clear

'carregar a lista
With rs
.Open "select * from mes", cn, adOpenKeyset, adLockOptimistic

If .RecordCount = 0 Then
MsgBox "Não existe(m) dado(s) cadastrado(s) no sistema.", vbExclamation, "Erro"
Else
Do Until rs.EOF
Set lst = ListView1.ListItems.Add(, , rs("mes"))
lst.SubItems(1) = rs("Valor1")
lst.SubItems(2) = rs("Valor2")
lst.SubItems(3) = rs("Valor3")
lst.SubItems(4) = rs("Valor4")
lst.SubItems(5) = rs("Valor5")

rs.MoveNext
Loop
End If
.Close
End With

'desmarca a lista
ListView1.SelectedItem.Selected = False
End Sub

Agrora modele o frmGrafico como mostra a figura abaixo:

Para inserir o Gráfico, na barra de componente, dê um duplo clique em MSChart, como mostra a figura abaixo:

Codifique o frmGrafico da seguinte forma:

Private Sub Form_Load()
With MSChart1
rs.Open "select valor1, valor2, valor3, valor4, valor5 from mes", cn, adOpenKeyset, adLockOptimistic
rs.MoveFirst

Set .DataSource = rs
.ShowLegend = True
rs.Close
End With
End Sub

Private Sub cmdExcel_Click()
Dim i, n, col, lin As Long
Dim f, letras As String
Dim objExcel As Excel.Application
Dim objWorkbook As Excel.Workbook

On Error Resume Next

letras = "ABCDEFGHIJKLMNOPQRSTUVWXYZAAABAC
ADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUA
VAWAXAYAZBABBBCBDBEBFBGBH"

Set objExcel = New Excel.Application
Set objExcel = GetObject(, "Excel.Application")
If Err.Number Then
Err.Clear
Set objExcel = CreateObject("Excel.Application")
If Err.Number Then
MsgBox "Não foi possivel abrir o Excel."
End If
End If
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add

rs.Open "select * from mes", cn, adOpenKeyset, adLockOptimistic
'--- conta as linhas ---
Do While Not rs.EOF
lin = lin + 1
rs.MoveNext
Loop

'--- conta as colunas ---
col = rs.Fields.Count

For i = 0 To 0
For n = 0 To col - 1
objWorkbook.ActiveSheet.Cells(i + 1, n + 1).Value = rs.Fields(n).Name
Next
Next

rs.MoveFirst ' move para o primeiro registro
For i = 1 To lin
For n = 0 To col - 1
objWorkbook.ActiveSheet.Cells(i + 1, n + 1).Value = rs.Fields(n).Value
Next
rs.MoveNext
Next

If col <= 26 Then
f = Mid(letras, col, 1) & lin + 1
Else
f = Mid(letras, col, 2) & lin + 1
End If

'--- grafico ---
Range("A1:" & f).Select

objExcel.Charts.Add
objExcel.ActiveChart.ChartType = xlColumnClustered
objExcel.ActiveChart.HasDataTable = True
objExcel.ActiveChart.DataTable.ShowLegendKey = True

rs.Close
Set objWorkbook = Nothing
Set objExcel = Nothing
End Sub

Private Sub cmdSair_Click()
Unload Me
End Sub

Por enquanto é só pessoal. Um abraço a todos.