Hola Fernando. Te paso un ejemplo de unas estadísticas que saco a excel desde
Visual Basic for Applications. Fijate que tanto si lo trabajas desde macros en
Excel o desde un Proyecto de Visual Basic, el codigo es exactamente el mismo.
Con respecto a tablas dinamicas, tenes que crearte un ODBC y luego desde excel
la creas usando \"Obtener Datos Externos\". Bueno, espero que te haya servido y
cualquier cosa que te pueda ayudar, contá conmigo.
Este código se encuentra insertado en un formulario que se encarga de procesar
la información.
Option Explicit
Public ven_cod As String
Public mes As Integer
Public anio As Integer
Private mobj_cnn As New ADODB.Connection
Private mhja_ResDiario As Worksheet
Private Sub RankinkProv()
Dim str_Sql As String
Dim rstRnkProv As New ADODB.Recordset
Dim rstTotal As New ADODB.Recordset
Dim hja_rankprov As Object
Dim lngPuesto As Long
Dim dblTotal As Double
str_Sql = \" select proveed.pro_cod,\"
str_Sql = str_Sql & \" max(proveed.pro_razsoc) as pro_razsoc,\"
str_Sql = str_Sql & \" sum(itemvta.ive_netoloc) As imp_tot \"
str_Sql = str_Sql & \" into #tmp_RnkProv \"
str_Sql = str_Sql & \" from itemvta, \"
str_Sql = str_Sql & \" articulos, \"
str_Sql = str_Sql & \" proveed \"
str_Sql = str_Sql & \" where itemvta.iveart_codgen =
articulos.art_codgen and \"
str_Sql = str_Sql & \" itemvta.iveart_codele1 =
articulos.art_codele1 and \"
str_Sql = str_Sql & \" itemvta.iveart_codele2 =
articulos.art_codele2 and \"
str_Sql = str_Sql & \" itemvta.iveart_codele3 =
articulos.art_codele3 and \"
str_Sql = str_Sql & \" articulos.artpro_cod = proveed.pro_cod
and \"
str_Sql = str_Sql & \" month(ivecve_femision) = \" & mes & \"
and \"
str_Sql = str_Sql & \" year(ivecve_femision) = \" & anio & \"
and \"
str_Sql = str_Sql & \" cveven_cod = \'\" & ven_cod & \"\' \"
str_Sql = str_Sql & \" Group by\"
str_Sql = str_Sql & \" proveed.pro_cod\"
str_Sql = str_Sql & \" Order by\"
str_Sql = str_Sql & \" sum(itemvta.ive_netoloc) desc\"
mobj_cnn.Execute str_Sql
str_Sql = \"select sum(imp_tot) as total from #tmp_RnkProv\"
rstTotal.Open str_Sql, mobj_cnn, adOpenStatic, adLockReadOnly
dblTotal = rstTotal!Total
rstTotal.Close
Set rstTotal = Nothing
str_Sql = \"select * from #tmp_RnkProv\"
rstRnkProv.Open str_Sql, mobj_cnn, adOpenStatic, adLockReadOnly
Set hja_rankprov = sps_estadisticas.Worksheets(\"Ranking_de_Proveedores\")
lngPuesto = 0
Do While Not rstRnkProv.EOF
hja_rankprov.Cells(lngPuesto + 4, 1) = lngPuesto + 1
hja_rankprov.Cells(lngPuesto + 4, 2) = rstRnkProv!pro_Cod
hja_rankprov.Cells(lngPuesto + 4, 3) = rstRnkProv!pro_razsoc
hja_rankprov.Cells(lngPuesto + 4, 4) = rstRnkProv!imp_tot
hja_rankprov.Cells(lngPuesto + 4, 5) = Round((rstRnkProv!imp_tot * 100)
/ dblTotal, 2)
lngPuesto = lngPuesto + 1
rstRnkProv.MoveNext
Loop
rstRnkProv.Close
Set rstRnkProv = Nothing
mobj_cnn.Execute \"drop table #tmp_RnkProv\"
End Sub
Private Sub RankinkClie()
Dim str_Sql As String
Dim rstRnkClie As New ADODB.Recordset
Dim rstTotal As New ADODB.Recordset
Dim hja_rankClie As Object
Dim lngPuesto As Long
Dim dblTotal As Double
str_Sql = \" select clientes.cli_cod,\"
str_Sql = str_Sql & \" max(clientes.cli_razsoc) as cli_razsoc,\"
str_Sql = str_Sql & \" sum(itemvta.ive_netoloc) As imp_tot\"
str_Sql = str_Sql & \" into #tmp_RnkClie \"
str_Sql = str_Sql & \" from cabventa, \"
str_Sql = str_Sql & \" itemvta, \"
str_Sql = str_Sql & \" clientes \"
str_Sql = str_Sql & \" where clientes.cli_cod = cabventa.cve_codcli
and \"
str_Sql = str_Sql & \" itemvta.ivecve_id = cabventa.cve_id
and \"
str_Sql = str_Sql & \" month(ivecve_femision) = \" & mes & \"
and \"
str_Sql = str_Sql & \" year(ivecve_femision) = \" & anio & \"
and \"
str_Sql = str_Sql & \" cliven_cod = \'\" & ven_cod & \"\'
\"
str_Sql = str_Sql & \" Group by \"
str_Sql = str_Sql & \" clientes.cli_cod \"
str_Sql = str_Sql & \" Order by \"
str_Sql = str_Sql & \" sum(itemvta.ive_netoloc) desc \"
mobj_cnn.Execute str_Sql
str_Sql = \"select sum(imp_tot) as total from #tmp_RnkClie\"
rstTotal.Open str_Sql, mobj_cnn, adOpenStatic, adLockReadOnly
dblTotal = rstTotal!Total
rstTotal.Close
Set rstTotal = Nothing
str_Sql = \"select * from #tmp_RnkClie\"
rstRnkClie.Open str_Sql, mobj_cnn, adOpenStatic, adLockReadOnly
Set hja_rankClie = sps_estadisticas.Worksheets(\"Ranking_de_Clientes\")
lngPuesto = 0
Do While Not rstRnkClie.EOF
hja_rankClie.Cells(lngPuesto + 4, 1) = lngPuesto + 1
hja_rankClie.Cells(lngPuesto + 4, 2) = rstRnkClie!cli_Cod
hja_rankClie.Cells(lngPuesto + 4, 3) = rstRnkClie!cli_RazSoc
hja_rankClie.Cells(lngPuesto + 4, 4) = rstRnkClie!imp_tot
hja_rankClie.Cells(lngPuesto + 4, 5) = Round((rstRnkClie!imp_tot * 100)
/ dblTotal, 2)
lngPuesto = lngPuesto + 1
rstRnkClie.MoveNext
Loop
rstRnkClie.Close
Set rstRnkClie = Nothing
mobj_cnn.Execute \"drop table #tmp_RnkClie\"
End Sub
Private Sub UserForm_Initialize()
Dim str_con As String
str_con = \"driver={sql server};server=HostName;uid=sa;pwd=Clave;\" & _
\"database=Nombre_Base\"
mobj_cnn.Open str_con
Set mhja_ResDiario = Worksheets(\"Diario_Mensual\")
mes = mhja_ResDiario.Cells(ActiveCell.Row, 1)
anio = mhja_ResDiario.Range(\"B2\").Value
ven_cod = gstrCodVend
lblTitulo.Caption = \"Resumen mensual correspondiente al mes: \" & mes &
\"/\" & anio
Call RankinkProv
Call RankinkClie
End Sub
-----------------
Buena Suerte!!!
__________________________________
Registrate desde
http://servicios.arnet.com.ar/registracion/registracion.asp?origenid=9 y
participá de todos los beneficios del Portal Arnet.