Buenos compañer@s, a ver si me podéis ayudar con esta macro. En esencia se conecta al AS400 de mi empresa (previa vista generada) y me trae datos a través de una consulta SQL. La macro funciona bien y no tengo problemas. El tema es que no sé trabajar recorriendo el RECORDSET y me toca ingeniármelas con un bucle Do Loop para que me vaya generando los datos que quiero. Os detallo la macro y las celdas donde me trae los datos. Lo que me gustaría es poder establecer el rango("C5:C18") de alguna forma en el RECORDSET para que lo hiciese de golpe y no recorriendo celda a celda. Asimismo, si por ejemplo, quisiese ampliar el rango de la matriz de datos y meter, por ejemplo, en D3 el mes 11, en D4 el mes 12, que me trajese los datos.
Muchas gracias
Option Explicit
Option Base 1
Public Sub VENTAS_SECCION_MES()
Dim sql As String, SheetName As String
Dim AÑO, CENTRO, SECCION, MES As String
Sheets("Ventas").Select
Range("C5").Select
Do Until ActiveCell.Offset(0, -1) = ""
AÑO = Range("C2").Value
CENTRO = Range("A3").Value
MES = Range("C3").Value
SECCION = ActiveCell.Offset(0, -2).Value
Application.Cursor = xlWait
Dim wb As Workbook, ws As Worksheet
'Venta de un año, un mes, una tienda y una sección
sql = _
"SELECT SUM(TOT_VENTAS) AS TOTAL_VENTAS " & _
"FROM PRESUPUESTO_VENTAS " & _
"WHERE ANYO = " & AÑO & " AND COD_CC = " & CENTRO & " AND SECCION= " & SECCION & " AND MES= " & MES & " "
SheetName = "Ventas"
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
ws.Name = SheetName
' Poner los datos particulares de la conexión
Dim Con As New ADODB.Connection
Con.Open "provider=IBMDA400;data source=172.16.1.1;Default Collection=-------;USER ID=-----;PASSWORD=-------;"
DownloadQuery Con, sql, SheetName
ActiveCell.Offset(1, 0).Select
Con.Close
Loop
Set Con = Nothing
Set wb = Nothing
Set ws = Nothing
Application.Cursor = xlDefault
End Sub
Private Sub DownloadQuery(Con As ADODB.Connection, sql As String, SheetName As String)
Dim Cmd As ADODB.Command
Dim Rs As ADODB.Recordset
Set Cmd = New ADODB.Command
Set Cmd.ActiveConnection = Con
Cmd.CommandText = sql
Dim ws As Worksheet, fld As ADODB.Field
Set ws = Worksheets(SheetName)
Set Rs = Cmd.Execute()
' Me trae el dato de la Consulta SQL
ActiveCell.CopyFromRecordset Rs
Set fld = Nothing
Set Rs = Nothing
End Sub
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Buenos compañer@s, a ver si me podéis ayudar con esta macro. En esencia se conecta al AS400 de mi empresa (previa vista generada) y me trae datos a través de una consulta SQL. La macro funciona bien y no tengo problemas. El tema es que no sé trabajar recorriendo el RECORDSET y me toca ingeniármelas con un bucle Do Loop para que me vaya generando los datos que quiero. Os detallo la macro y las celdas donde me trae los datos. Lo que me gustaría es poder establecer el rango("C5:C18") de alguna forma en el RECORDSET para que lo hiciese de golpe y no recorriendo celda a celda. Asimismo, si por ejemplo, quisiese ampliar el rango de la matriz de datos y meter, por ejemplo, en D3 el mes 11, en D4 el mes 12, que me trajese los datos.
Muchas gracias
Option Explicit
Option Base 1
Public Sub VENTAS_SECCION_MES()
Dim sql As String, SheetName As String
Dim AÑO, CENTRO, SECCION, MES As String
Sheets("Ventas").Select
Range("C5").Select
Do Until ActiveCell.Offset(0, -1) = ""
AÑO = Range("C2").Value
CENTRO = Range("A3").Value
MES = Range("C3").Value
SECCION = ActiveCell.Offset(0, -2).Value
Application.Cursor = xlWait
Dim wb As Workbook, ws As Worksheet
'Venta de un año, un mes, una tienda y una sección
sql = _
"SELECT SUM(TOT_VENTAS) AS TOTAL_VENTAS " & _
"FROM PRESUPUESTO_VENTAS " & _
"WHERE ANYO = " & AÑO & " AND COD_CC = " & CENTRO & " AND SECCION= " & SECCION & " AND MES= " & MES & " "
SheetName = "Ventas"
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
ws.Name = SheetName
' Poner los datos particulares de la conexión
Dim Con As New ADODB.Connection
Con.Open "provider=IBMDA400;data source=172.16.1.1;Default Collection=-------;USER ID=-----;PASSWORD=-------;"
DownloadQuery Con, sql, SheetName
ActiveCell.Offset(1, 0).Select
Con.Close
Loop
Set Con = Nothing
Set wb = Nothing
Set ws = Nothing
Application.Cursor = xlDefault
End Sub
Private Sub DownloadQuery(Con As ADODB.Connection, sql As String, SheetName As String)
Dim Cmd As ADODB.Command
Dim Rs As ADODB.Recordset
Set Cmd = New ADODB.Command
Set Cmd.ActiveConnection = Con
Cmd.CommandText = sql
Dim ws As Worksheet, fld As ADODB.Field
Set ws = Worksheets(SheetName)
Set Rs = Cmd.Execute()
' Me trae el dato de la Consulta SQL
ActiveCell.CopyFromRecordset Rs
Set fld = Nothing
Set Rs = Nothing
End Sub