Jump to content
giordancisco

ANSWERED Sentencia SQL para Informe de reparto

Recommended Posts

Como va? hace un tiempo arme un formulario en excel que consistía en realizar un resumen de de los comprobantes de repartos a través del llenado de un listbox que luego se exportaba en pdf. Adjunto a continuación un ejemplo del pdf que actualmente genera:  https://drive.google.com/file/d/1jeIvxYVisSuZ4bUHuQsN-NRUrdoXyLXJ/view?usp=sharing

Ahora funciona a través de los datos que se encuentran en las tablas de excel. El código es un doble bucle for next que como ya mencione llena los datos en un listbox, la ultima columna del mismo es la parte conflictiva ya que en una sola fila almacena todos los productos que contiene una factura de reparto y los separa a través de un salto de linea para que finalmente mediante el código que lo exporta a pdf envié todos los productos con dicho salto a una sola celda.

El problema que tengo ahora es que necesito que el informe obtenga los datos de una base de datos Access y mediante una sentencia SQL no se como obtener el mismo resultado o similar. Apelo a la creatividad y conocimientos de los mas experimentados en este foro, hace días que vengo intentando y no logro solucionarlo. Desde ya muchas gracias y un abrazo.

Adjuntos: https://drive.google.com/file/d/1r39L8xqjk0wKmS0oFsO3kpOxM9hY4qL3/view?usp=sharing

El formulario se llama "reparto"

actualmente hay cargadas 2 facturas de reparto con fecha 29/6/2019 turno: tarde

antes de apretar el botón exportar se deben seleccionar las 2 facturas en el listbox para que se carguen al pdf

Edited by giordancisco
aclaraciones

Share this post


Link to post
Share on other sites

No explicas de que tablas de la BD salen los datos correspondientes a las hojas REGCAJA y REGPRODUCTOS, para otra vez se más concreto ya que ha sido un poco complicado averiguarlo.

Sustituye el procedimiento de búsqueda por este:

Private Sub cargar_Click()
Dim cn As Object
Dim rs As Object
Dim x As Long
Dim Anterior As String
Dim BD As String

Application.ScreenUpdating = False
Set cn = CreateObject("ADODB.Connection")

BD = ThisWorkbook.Path & "\Buscador de Precios 64 bits 9-4-19 nuevas tablas.accdb" '<------

Conexion = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & BD
cn.Open Conexion
Set rs = New ADODB.Recordset

With rs
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
End With

If turno.ListIndex > -1 Then whereturno = "UCASE(caja.Turno)='" & UCase(turno) & "' AND "
If txt_Buscar.ListIndex > -1 Then wheretipo = "UCASE(caja.[Tipo comprobante])='" & UCase(txt_Buscar) & "' AND "

Sql = "SELECT caja.Fecha, caja.Turno, caja.[Nº Comprobante], caja.[Tipo comprobante], "
Sql = Sql & "caja.Observacion, caja.Dirección, caja.[Obs Pago],salidas.Cantidad, salidas.Cod, salidas.Descripción "
Sql = Sql & "FROM caja INNER JOIN salidas ON caja.[Nº Comprobante] = salidas.Factura "
Sql = Sql & " WHERE " & whereturno & wheretipo & "caja.Fecha=#" & CDate(fecha) & "# "

rs.Open Sql, Conexion
Sheets.Add
ActiveSheet.Cells.Clear
ActiveSheet.Range("A1").CopyFromRecordset rs
    
rs.Close
Set rs = Nothing

cn.Close
Set cn = Nothing
'----
x = 1
With ActiveSheet
   Do Until .Range("A" & x) = ""
      If .Range("C" & x) <> Anterior Then
         ListBox1.AddItem .Range("C" & x)
         ListBox1.List(ListBox1.ListCount - 1, 1) = .Range("D" & x)
         ListBox1.List(ListBox1.ListCount - 1, 2) = .Range("E" & x)
         ListBox1.List(ListBox1.ListCount - 1, 3) = .Range("F" & x)
         ListBox1.List(ListBox1.ListCount - 1, 4) = .Range("G" & x)
         Anterior = .Range("C" & x)
      End If
      ListBox1.List(ListBox1.ListCount - 1, 5) = ListBox1.List(ListBox1.ListCount - 1, 5) & _
               .Range("H" & x) & ") " & .Range("I" & x) & "-" & .Range("J" & x) & vbCrLf
      x = x + 1
   Loop
End With
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End Sub

 

Share this post


Link to post
Share on other sites
Hace 3 horas, Antoni dijo:

No explicas de que tablas de la BD salen los datos correspondientes a las hojas REGCAJA y REGPRODUCTOS, para otra vez se más concreto ya que ha sido un poco complicado averiguarlo.

Sustituye el procedimiento de búsqueda por este:


Private Sub cargar_Click()
Dim cn As Object
Dim rs As Object
Dim x As Long
Dim Anterior As String
Dim BD As String

Application.ScreenUpdating = False
Set cn = CreateObject("ADODB.Connection")

BD = ThisWorkbook.Path & "\Buscador de Precios 64 bits 9-4-19 nuevas tablas.accdb" '<------

Conexion = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & BD
cn.Open Conexion
Set rs = New ADODB.Recordset

With rs
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
End With

If turno.ListIndex > -1 Then whereturno = "UCASE(caja.Turno)='" & UCase(turno) & "' AND "
If txt_Buscar.ListIndex > -1 Then wheretipo = "UCASE(caja.[Tipo comprobante])='" & UCase(txt_Buscar) & "' AND "

Sql = "SELECT caja.Fecha, caja.Turno, caja.[Nº Comprobante], caja.[Tipo comprobante], "
Sql = Sql & "caja.Observacion, caja.Dirección, caja.[Obs Pago],salidas.Cantidad, salidas.Cod, salidas.Descripción "
Sql = Sql & "FROM caja INNER JOIN salidas ON caja.[Nº Comprobante] = salidas.Factura "
Sql = Sql & " WHERE " & whereturno & wheretipo & "caja.Fecha=#" & CDate(fecha) & "# "

rs.Open Sql, Conexion
Sheets.Add
ActiveSheet.Cells.Clear
ActiveSheet.Range("A1").CopyFromRecordset rs
    
rs.Close
Set rs = Nothing

cn.Close
Set cn = Nothing
'----
x = 1
With ActiveSheet
   Do Until .Range("A" & x) = ""
      If .Range("C" & x) <> Anterior Then
         ListBox1.AddItem .Range("C" & x)
         ListBox1.List(ListBox1.ListCount - 1, 1) = .Range("D" & x)
         ListBox1.List(ListBox1.ListCount - 1, 2) = .Range("E" & x)
         ListBox1.List(ListBox1.ListCount - 1, 3) = .Range("F" & x)
         ListBox1.List(ListBox1.ListCount - 1, 4) = .Range("G" & x)
         Anterior = .Range("C" & x)
      End If
      ListBox1.List(ListBox1.ListCount - 1, 5) = ListBox1.List(ListBox1.ListCount - 1, 5) & _
               .Range("H" & x) & ") " & .Range("I" & x) & "-" & .Range("J" & x) & vbCrLf
      x = x + 1
   Loop
End With
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End Sub

 

Funciona! increíblemente bien!. Cuando estaba a punto de solucionarlo de la forma mas chapucera, enviando los datos a access ya unidos para después volverlos a llamar, aparece como siempre Antoni con una solución. Muchas gracias de corazón señor.

A continuación adjunto el archivo con el código modificado, solo le agregue el listbox.clear, y un pdf con los resultados arrojados: https://drive.google.com/file/d/1MD9_6SRCDyH7TvfaKPy5cf03DXhaYCAW/view?usp=sharing

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.

×
×
  • Create New...

Important Information

Privacy Policy

Ayuda Excel - Madrid, Madrid, ES - Valorada por 5112 personas - Aprender Excel - Total: 4.7 / 5