Olá pessoal! Esta semana vamos criar um
exemplo de estatística ultilizando os controles MS Chart
e ListView, com possibilidade de exportar para Excel. E para transportar
dados para o Excel, vamos usar a API do Windows shell32.dll.
Clique aqui para
baixar o banco que será usado neste exemplo.
No Visual Basic, crie um novo Projeto com nome de Estatística e renomeie o Form1 para frmDados. Depois inclua mais um form como mostram as figuras abaixo:

Remonei o Form2 para frmGrafico.
Insira um Módulo com o nome de modCnn, como mostra a figura abaixo:

Crie dentro do Módulo, o código de conexão com o banco como mostram as linhas abaixo:
Option Explicit
Private Declare Function
ShellExecute Lib "shell32.dll"
Alias _
"ShellExecuteA" (ByVal
HWnd As Long, ByVal
lpOperation _
As String, ByVal
lpFile As String, ByVal
lpParameters _
As String, ByVal
lpDirectory As String, ByVal
nShowCmd _
As Long) As
Long
Global cn As
ADODB.Connection
Global rs As
ADODB.Recordset
Private Sub Main()
Dim strArquivo As
String
Dim strLocal As String
Dim Conecta As String
DoEvents
Set cn = New
ADODB.Connection
/font color="#0066CC">Set rs = New<font>
ADODB.Recordset
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.
Rodrigo Machado
Este foi o melhor site que encontrei ensinando a programar em VB. Os exemplos muito simples e elucidativos das vossa colunas permitem a qualquer um aprender. Eu vou até aprender outras linguagens de programação disponíveis no vosso site.
Estão de PARABÉNS!
Isolina Gonçalves
Estudante de Engenharia Informática no ISCTEM
Maputo - Moçambique
Lademar
Baixei o Bco de dados e nao consigo abri-lo da a seguinte mensagem - Unrecognized database format,
e nao consigo criar o gafico na frmgrafico, o icone do mschrt20.ocx nao aparece..e esta tudo ativado..o que pode ser..???
Grato
Lademar
Ola....consegui, mas como o Access de vcs é 2000 e estou usando o 97, poderiam me ajudar a criar..ou preparar um e me enviar para o access 97.
Grato
Gabriel Nazareth Maia
fiz tudo direito testei pelo vb e foi tudo uma maravilha mas quando criei o instalador e instalalei em outra maquina, c/ o window 98, não funcionou..apareceu a mensagem que não consegui abrir o EXCEL
Patricia Nigro
O artigo podia ser mais completo, tem mto pra falar ainda... + vlw!
2001 - iMasters FFPA Informática Ltda - Todos os direitos reservados.