quisiera que me ayudaran con el siguinte caso, tengo un archivo en donde extraigo los datos del programa de la empresa que trabajo, pero esta consulta sql me los agrupa y no me los muestra de forma individual.
Private Sub UserForm_Activate()
Dim Db As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim SQL As String
Dim i As Integer
Call InicializarVariables
Db.Open CONSTRING
For i = 0 To 365
Me.cmb_Fini.AddItem Format(CDate(CAL_FECHA) - i, "YYYY/MM/DD")
Me.cmb_FFin.AddItem Format(CDate(CAL_FECHA) - i, "YYYY/MM/DD")
Next i
Me.cmb_Fini.ListIndex = 180
Me.cmb_FFin.ListIndex = 0
SQL = "Select * from linea Where Cod_Linea not in (0,1,6,13,14) order by Nom_Linea"
Rs.Open SQL, Db
Me.cmb_LProd.Clear
Me.List_LProd.Clear
If Not Rs.EOF Then
While Not Rs.EOF
Me.cmb_LProd.AddItem Rs("Nom_Linea")
Me.List_LProd.AddItem Rs("Cod_Linea")
Rs.MoveNext
Wend
Me.cmb_LProd.AddItem "TODAS"
Me.List_LProd.AddItem "999"
End If
Rs.Close
Db.Close
Me.cmb_LProd.ListIndex = 0
Me.List_LProd.ListIndex = Me.cmb_LProd.ListIndex
End Sub
Private Sub cmb_LProd_Click()
Me.List_LProd.ListIndex = Me.cmb_LProd.ListIndex
End Sub
Private Sub cmd_Aceptar_Click()
Dim Db As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Rs2 As New ADODB.Recordset
Dim Rs3 As New ADODB.Recordset
Dim Rs4 As New ADODB.Recordset
Dim SQL As String
Dim i As Integer
Dim j As Long
Dim k As Long
Dim sLineas As String
Dim QLote, QTarjeta, QEmpaque As Integer
'------------------------------------
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'------------------------------------
Hoja1.Range("A10:U20000").Clear
Hoja1.Range("A10:U20000").Interior.Color = &HF5F5F5
Hoja1.Range("A10:U20000").Font.Color = &H8000000D
Hoja1.Cells(4, 1) = "Intervalo:" & Me.cmb_Fini & "-" & Me.cmb_FFin
Hoja1.Cells(5, 1) = "Linea de Producción:" & Me.cmb_LProd
SQL = "Select C.nom_cliente,O.Cod_Cliente,O.Cod_Obra,O.Estado,O.FAprob,O.FDesp,P.NoOrden_Pprog,P.CodLote_pprog, L.nom_linea,min(P.Fecha_Pprog) Fecha_Pprog,Sum(P.Cantidad_Pprog) Cantidad, OT.descrip_tord "
SQL = SQL & "From cliente C, orden O, programacion_prod P, linea L, ordentipo OT "
SQL = SQL & "Where O.Cod_Cliente=P.CodCliente_Pprog AND "
SQL = SQL & "O.No_Orden=P.NoOrden_Pprog AND "
SQL = SQL & "P.CodLote_pprog<>-1 AND P.codlinea_pprog=L.cod_linea AND O.codtipoorden = OT.cod_tord AND C.cod_cliente not in (2478,2479) AND "
If Me.cmb_LProd.List(Me.cmb_LProd.ListIndex) <> "TODAS" Then
SQL = SQL & "P.CodLinea_Pprog=" & Me.List_LProd.List(Me.cmb_LProd.ListIndex) & " AND "
End If
SQL = SQL & "P.Fecha_pprog>='" & Me.cmb_Fini & "' AND "
SQL = SQL & "P.Fecha_pprog<='" & Me.cmb_FFin & "' AND "
SQL = SQL & "C.cod_cliente=O.cod_cliente "
SQL = SQL & "AND O.ESTADO='APROBADA' "
[COLOR=#ff0000] SQL = SQL & "Group BY C.nom_cliente,O.Cod_Cliente,O.Cod_Obra,O.Estado,O.FAprob,P.NoOrden_Pprog,P.CodLote_pprog,L.nom_linea "
SQL = SQL & "Order BY O.FAprob,P.NoOrden_Pprog, P.CodLote_pprog"[/COLOR]
Db.Open CONSTRING
Rs.Open SQL, Db
i = 10
While Not Rs.EOF
DoEvents
Hoja1.Cells(i, 20) = Rs("Nom_Linea")
Hoja1.Cells(i, 21) = Rs("descrip_tord")
Hoja1.Cells(i, 1) = Rs("Nom_Cliente")
'Obra
SQL = "Select Nom_Obra From obra Where Cod_Cliente='" & Rs("Cod_Cliente") & "' and Cod_Obra='" & Rs("Cod_Obra") & "'"
Rs3.Open SQL, Db
If Not Rs3.EOF Then
Hoja1.Cells(i, 2) = Rs3("Nom_Obra")
End If
Rs3.Close
'ANCHO
SQL = "Select Ancho_mm From detalle_pedido Where Cod_Cliente='" & Rs("Cod_Cliente") & "' and no_orden='" & Rs("noorden_pprog") & "'"
Rs3.Open SQL, Db
If Not Rs3.EOF Then
Hoja1.Cells(i, 23) = Rs3("Ancho_mm")
End If
Rs3.Close
'LARGO
''''''''''''''''''
SQL = "Select Largo_mm From detalle_pedido Where Cod_Cliente='" & Rs("Cod_Cliente") & "' and no_orden='" & Rs("noorden_pprog") & "'"
Rs3.Open SQL, Db
If Not Rs3.EOF Then
Hoja1.Cells(i, 24) = Rs3("Largo_mm")
End If
Rs3.Close
'ITEM
''''''''''''''''''
SQL = "Select N_Item From detalle_pedido Where Cod_Cliente='" & Rs("Cod_Cliente") & "' and no_orden='" & Rs("noorden_pprog") & "'"
Rs3.Open SQL, Db
If Not Rs3.EOF Then
Hoja1.Cells(i, 22) = Rs3("N_Item")
End If
Rs3.Close
'COMPOSICION
SQL = "Select Composicion From orden Where Cod_Cliente='" & Rs("Cod_Cliente") & "' and no_orden='" & Rs("noorden_pprog") & "'"
Rs3.Open SQL, Db
If Not Rs3.EOF Then
Hoja1.Cells(i, 25) = Rs3("Composicion")
End If
Rs3.Close
'M2
Hoja1.Cells(i, 3) = Rs("NoOrden_Pprog") & IIf(Mid(Rs("estado"), 1, 2) = "AP", "", "(" & Mid(Rs("estado"), 1, 2) & ")")
Hoja1.Cells(i, 4) = Rs("CodLote_pprog")
Hoja1.Cells(i, 5) = Rs("Cantidad")
'Fecha Aprobación
If Rs("FAprob") > Rs("Fecha_Pprog") Then
Hoja1.Cells(i, 6) = Rs("Fecha_Pprog")
Else
If Trim(Rs("faprob")) = "" Then
Hoja1.Cells(i, 6) = Rs("Fecha_Pprog")
Else
Hoja1.Cells(i, 6) = Rs("FAprob")
End If
End If
Hoja1.Cells(i, 7) = Rs("FDesp")
'Fecha Programación
Hoja1.Cells(i, 8) = Rs("Fecha_Pprog")
Hoja1.Cells(i, 14) = DateDiff("d", CDate(Rs("Fecha_Pprog")), Format(Now(), "yyyy/mm/dd"))
Hoja1.Cells(i, 17) = DateDiff("d", CDate(Rs("FAprob")), Format(Now(), "yyyy/mm/dd"))
'Fecha Corte
SQL = "Select min(Fecha) fechaini From corte "
SQL = SQL & "Where No_Lote =" & Rs("CodLote_pprog") & ""
Rs3.Open SQL, Db
If Not Rs3.EOF Then
Hoja1.Cells(i, 9) = Rs3("fechaini")
End If
Hoja1.Cells(i, 18) = DateDiff("d", CDate(Rs("FAprob")), Rs3("fechaini"))
Rs3.Close
Hoja1.Cells(i, 12) = CInt(DateDiff("d", CDate(Hoja1.Cells(i, 6)), Format(Now, "YYYY/MM/DD")))
Hoja1.Cells(i, 11) = CInt(DateDiff("d", CDate(Hoja1.Cells(i, 6)), CDate(Hoja1.Cells(i, 8))))
QLote = 0
QTarjeta = 0
QEmpaque = 0
If Rs("noorden_pprog") = "4500017903" Then
a = 0
End If
SQL = "Select sum(Cantidad)-sum(Empacado) dif from detalle_pedido where cod_cliente='" & Rs("cod_cliente") & "' and no_orden='" & Rs("noorden_pprog") & "'"
Rs2.Open SQL, Db
If Not Rs2.EOF Then
If Rs2("Dif") > 0 Then
SQL = "Select Sum(Cantidad),Sum(cantidad)-Sum(empacado) From detalle_lote Where cod_cliente='" & Rs("cod_cliente") & "' and No_Lote=" & Rs("CodLote_pprog") & " and No_Orden= '" & Rs("NoOrden_Pprog") & "'"
Rs3.Open SQL, Db
If Not Rs3.EOF And Rs3(1) > 0 Then
QLote = Rs("Cantidad")
SQL = "Select Sum(En_TarjetaEsp) From tarjeta T,detalle_tarjeta DT Where T.Cod_tarjeta=DT.Cod_Tarjeta and T.cod_cliente='" & Rs("cod_cliente") & "' and No_Orden= '" & Rs("NoOrden_Pprog") & "' and No_Lote=" & Rs("CodLote_pprog") & ""
'If InStr(1, Me.cmb_LProd.List(Me.cmb_LProd.ListIndex), "LAMINADO") = 0 Then
' SQL = SQL & " and cod_empaque like 'E%'"
'Else
SQL = SQL & " and num_linea=" & Me.List_LProd.List(Me.cmb_LProd.ListIndex) & ""
'End If
Rs4.Open SQL, Db
If Not Rs4.EOF And Rs4(0) <> "" Then
QEmpaque = Rs4(0)
Else
QEmpaque = 0
End If
Rs4.Close
Hoja1.Cells(i, 13) = QLote - QEmpaque
'QUERY para Mt2 Faltantes por producir. - Rafa
SQL = "Select B.Mt2_Tarjeta,A.Mt2_Lote " _
& "From " _
& "(Select sum(round((dp.ancho_mm*dp.largo_mm)/1000000,2) * pp.cantidad_pprog) Mt2_Lote,dp.cod_cliente,dp.no_orden " _
& "From programacion_prod pp " _
& "Inner Join detalle_pedido dp on dp.cod_cliente=pp.codcliente_pprog and dp.no_orden=pp.noorden_pprog and dp.n_item=pp.nitem_pprog " _
& "Where pp.codcliente_pprog = " & Rs("cod_cliente") & " and pp.noorden_pprog = '" & Rs("NoOrden_Pprog") & "' and pp.codlote_pprog = " & Rs("CodLote_pprog") & " and pp.codlinea_pprog = " & Me.List_LProd.List(Me.cmb_LProd.ListIndex) & " Group by pp.codcliente_pprog,pp.noorden_pprog ) A " _
& "Left Join " _
& "(Select sum(round((dp.ancho_mm*dp.largo_mm)/1000000,2) * en_tarjetaesp) Mt2_Tarjeta, dl.cod_cliente,dl.no_orden " _
& "From detalle_lote dl " _
& "Left Join tarjeta t on t.cod_cliente=dl.cod_cliente and t.no_orden=dl.no_orden " _
& "Left Join detalle_tarjeta dt on dt.cod_tarjeta=t.cod_tarjeta and dt.no_lote=dl.no_lote and dt.no_item=dl.n_item " _
& "Inner Join detalle_pedido dp on dp.cod_cliente=dl.cod_cliente and dp.no_orden=dl.no_orden and dp.n_item=dl.n_item " _
& "Where dl.cod_cliente = " & Rs("cod_cliente") & " and dl.no_orden = '" & Rs("NoOrden_Pprog") & "' and dl.no_lote = " & Rs("CodLote_pprog") & " and num_linea=" & Me.List_LProd.List(Me.cmb_LProd.ListIndex) & " Group by dl.cod_cliente,dl.no_orden) B on A.cod_cliente=B.cod_cliente and A.no_orden=B.no_orden "
Rs4.Open SQL, Db
If Not Rs4.EOF Then
Hoja1.Cells(i, 19) = Rs4(1) - (IIf(IsNull(Rs4(0)), 0, Rs4(0)))
Else
Hoja1.Cells(i, 19) = 0
End If
Rs4.Close
If Hoja1.Cells(i, 13) <= 0 Then
'Fecha Ultimo Empaque
SQL = "Select max(fecha_actualizacion) UltEmp, sum(en_tarjetaesp) TEmp "
SQL = SQL & " From tarjeta e,detalle_tarjeta de "
SQL = SQL & " Where e.cod_tarjeta=de.cod_tarjeta and e.cod_cliente='" & Rs("cod_cliente") & "' and de.no_lote=" & Rs("CodLote_pprog") & " and e.no_orden= '" & Rs("NoOrden_Pprog") & "'"
Rs4.Open SQL, Db
If Not Rs3.EOF Then
Hoja1.Cells(i, 12) = CInt(DateDiff("d", CDate(Hoja1.Cells(i, 6)), CDate(Rs4("UltEmp"))))
Hoja1.Cells(i, 10) = Rs4("UltEmp")
End If
Rs4.Close
Else
cant = 1
If Me.List_LProd.List(Me.cmb_LProd.ListIndex) = 4 Then
SQL = "Select count(distinct(codlinea_pprog)) "
SQL = SQL & "From programacion_prod P "
SQL = SQL & "Where "
SQL = SQL & "P.CodLote_pprog<>-1 AND "
SQL = SQL & "codcliente_pprog>='" & Rs("cod_cliente") & "' AND "
SQL = SQL & "noorden_pprog='" & Rs("noorden_pprog") & "' "
Rs4.Open SQL, Db
If Not Rs4.EOF Then
cant = Rs4(0)
End If
Rs4.Close
End If
Select Case cant
Case Is = 1
If Hoja1.Cells(i, 12) > 3 Then
Hoja1.Cells(i, 1).Interior.Color = &HFF&
Hoja1.Cells(i, 2).Interior.Color = &HFF&
Hoja1.Cells(i, 3).Interior.Color = &HFF&
Hoja1.Cells(i, 4).Interior.Color = &HFF&
Hoja1.Cells(i, 5).Interior.Color = &HFF&
Hoja1.Cells(i, 6).Interior.Color = &HFF&
Hoja1.Cells(i, 7).Interior.Color = &HFF&
Hoja1.Cells(i, 8).Interior.Color = &HFF&
Hoja1.Cells(i, 9).Interior.Color = &HFF&
Hoja1.Cells(i, 10).Interior.Color = &HFF&
Hoja1.Cells(i, 11).Interior.Color = &HFF&
Hoja1.Cells(i, 12).Interior.Color = &HFF&
Hoja1.Cells(i, 13).Interior.Color = &HFF&
Hoja1.Cells(i, 15).Interior.Color = &HFF&
Hoja1.Cells(i, 10) = "VENCIDO"
Else
Hoja1.Cells(i, 1).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 2).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 3).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 4).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 5).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 6).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 7).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 8).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 9).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 10).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 11).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 12).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 13).Interior.Color = &HFF&
Hoja1.Cells(i, 10) = "NO VENCIDO"
End If
Case Is > 1
If Hoja1.Cells(i, 12) > 7 Then
Hoja1.Cells(i, 1).Interior.Color = &HFF&
Hoja1.Cells(i, 2).Interior.Color = &HFF&
Hoja1.Cells(i, 3).Interior.Color = &HFF&
Hoja1.Cells(i, 4).Interior.Color = &HFF&
Hoja1.Cells(i, 5).Interior.Color = &HFF&
Hoja1.Cells(i, 6).Interior.Color = &HFF&
Hoja1.Cells(i, 7).Interior.Color = &HFF&
Hoja1.Cells(i, 8).Interior.Color = &HFF&
Hoja1.Cells(i, 9).Interior.Color = &HFF&
Hoja1.Cells(i, 10).Interior.Color = &HFF&
Hoja1.Cells(i, 11).Interior.Color = &HFF&
Hoja1.Cells(i, 12).Interior.Color = &HFF&
Hoja1.Cells(i, 13).Interior.Color = &HFF&
Hoja1.Cells(i, 17).Interior.Color = &HFF&
Hoja1.Cells(i, 10) = "VENCIDO"
Else
Hoja1.Cells(i, 1).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 2).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 3).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 4).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 5).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 6).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 7).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 8).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 9).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 10).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 11).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 12).Interior.Color = &HD0C0A8
Hoja1.Cells(i, 13).Interior.Color = &HFF&
Hoja1.Cells(i, 10) = "NO VENCIDO"
End If
End Select
End If
Else
'terminado
'Fecha Ultimo Empaque
SQL = "Select max(fecha_actualizacion) UltEmp "
SQL = SQL & " From tarjeta e,detalle_tarjeta de "
SQL = SQL & " Where e.cod_tarjeta=de.cod_tarjeta and e.cod_cliente='" & Rs("cod_cliente") & "' and de.no_lote=" & Rs("CodLote_pprog") & " and e.no_orden= '" & Rs("NoOrden_Pprog") & "'"
Rs4.Open SQL, Db
If Not Rs4.EOF And IsNull(Rs4("ultemp")) = False Then
Hoja1.Cells(i, 12) = CInt(DateDiff("d", CDate(Hoja1.Cells(i, 6)), CDate(Rs4("UltEmp"))))
Hoja1.Cells(i, 10) = Rs4("UltEmp")
End If
Rs4.Close
Hoja1.Cells(i, 13) = QLote - QEmpaque
End If
Rs3.Close
Else
'terminado
'Fecha Ultimo Empaque
SQL = "Select max(fecha_actualizacion) UltEmp "
SQL = SQL & " From tarjeta e,detalle_tarjeta de "
SQL = SQL & " Where e.cod_tarjeta=de.cod_tarjeta and e.cod_cliente='" & Rs("cod_cliente") & "' and de.no_lote=" & Rs("CodLote_pprog") & " and e.no_orden= '" & Rs("NoOrden_Pprog") & "'"
Rs4.Open SQL, Db
If Not Rs4.EOF And IsNull(Rs4("ultemp")) = False Then
Hoja1.Cells(i, 12) = CInt(DateDiff("d", CDate(Hoja1.Cells(i, 6)), CDate(Rs4("UltEmp"))))
Hoja1.Cells(i, 10) = Rs4("UltEmp")
End If
Rs4.Close
Hoja1.Cells(i, 13) = QLote - QEmpaque
End If
End If
Rs2.Close
'Si es cero no pasa a la siguiente línea
If CStr(Hoja1.Cells(i, 13)) <> 0 Then
sLineas = ""
SQL = "select nom_linea from linea, orden_linea where cod_linea=codlinea_ola and " _
& "codcliente_ola=" & Rs("Cod_Cliente") & " and noorden_ola='" & Rs("NoOrden_Pprog") & "' " _
& "group by nom_linea order by nom_linea"
Rs3.Open SQL, Db
While Not Rs3.EOF
sLineas = sLineas & "-" & Left(Rs3("nom_linea"), 3) '& IIf(IsNumeric(Right(Rs3("nom_linea"), 1)), Right(Rs3("nom_linea"), 1), "")
Rs3.MoveNext
Wend
Rs3.Close
Hoja1.Cells(i, 15) = Right(sLineas, Len(sLineas) - 1)
i = i + 1
End If
Rs.MoveNext
Wend
Rs.Close
Db.Close
If CStr(Hoja1.Cells(i, 13)) = "0" Then
Hoja1.Range("A" & i, "U" & i) = ""
End If
'---------------------------
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
'-------------------------------
UserForm1.Hide
End Sub
el texto sombreado con rojo es el que agrupa los datos, pero al quitar este group by no me aparece nada en la hoja.
les agradezco su atención.
Editado por moderación para envolver código con etiquetas.
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
cordial saludo,
quisiera que me ayudaran con el siguinte caso, tengo un archivo en donde extraigo los datos del programa de la empresa que trabajo, pero esta consulta sql me los agrupa y no me los muestra de forma individual.
Private Sub UserForm_Activate() Dim Db As New ADODB.Connection Dim Rs As New ADODB.Recordset Dim SQL As String Dim i As Integer Call InicializarVariables Db.Open CONSTRING For i = 0 To 365 Me.cmb_Fini.AddItem Format(CDate(CAL_FECHA) - i, "YYYY/MM/DD") Me.cmb_FFin.AddItem Format(CDate(CAL_FECHA) - i, "YYYY/MM/DD") Next i Me.cmb_Fini.ListIndex = 180 Me.cmb_FFin.ListIndex = 0 SQL = "Select * from linea Where Cod_Linea not in (0,1,6,13,14) order by Nom_Linea" Rs.Open SQL, Db Me.cmb_LProd.Clear Me.List_LProd.Clear If Not Rs.EOF Then While Not Rs.EOF Me.cmb_LProd.AddItem Rs("Nom_Linea") Me.List_LProd.AddItem Rs("Cod_Linea") Rs.MoveNext Wend Me.cmb_LProd.AddItem "TODAS" Me.List_LProd.AddItem "999" End If Rs.Close Db.Close Me.cmb_LProd.ListIndex = 0 Me.List_LProd.ListIndex = Me.cmb_LProd.ListIndex End Sub Private Sub cmb_LProd_Click() Me.List_LProd.ListIndex = Me.cmb_LProd.ListIndex End Sub Private Sub cmd_Aceptar_Click() Dim Db As New ADODB.Connection Dim Rs As New ADODB.Recordset Dim Rs2 As New ADODB.Recordset Dim Rs3 As New ADODB.Recordset Dim Rs4 As New ADODB.Recordset Dim SQL As String Dim i As Integer Dim j As Long Dim k As Long Dim sLineas As String Dim QLote, QTarjeta, QEmpaque As Integer '------------------------------------ Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False '------------------------------------ Hoja1.Range("A10:U20000").Clear Hoja1.Range("A10:U20000").Interior.Color = &HF5F5F5 Hoja1.Range("A10:U20000").Font.Color = &H8000000D Hoja1.Cells(4, 1) = "Intervalo:" & Me.cmb_Fini & "-" & Me.cmb_FFin Hoja1.Cells(5, 1) = "Linea de Producción:" & Me.cmb_LProd SQL = "Select C.nom_cliente,O.Cod_Cliente,O.Cod_Obra,O.Estado,O.FAprob,O.FDesp,P.NoOrden_Pprog,P.CodLote_pprog, L.nom_linea,min(P.Fecha_Pprog) Fecha_Pprog,Sum(P.Cantidad_Pprog) Cantidad, OT.descrip_tord " SQL = SQL & "From cliente C, orden O, programacion_prod P, linea L, ordentipo OT " SQL = SQL & "Where O.Cod_Cliente=P.CodCliente_Pprog AND " SQL = SQL & "O.No_Orden=P.NoOrden_Pprog AND " SQL = SQL & "P.CodLote_pprog<>-1 AND P.codlinea_pprog=L.cod_linea AND O.codtipoorden = OT.cod_tord AND C.cod_cliente not in (2478,2479) AND " If Me.cmb_LProd.List(Me.cmb_LProd.ListIndex) <> "TODAS" Then SQL = SQL & "P.CodLinea_Pprog=" & Me.List_LProd.List(Me.cmb_LProd.ListIndex) & " AND " End If SQL = SQL & "P.Fecha_pprog>='" & Me.cmb_Fini & "' AND " SQL = SQL & "P.Fecha_pprog<='" & Me.cmb_FFin & "' AND " SQL = SQL & "C.cod_cliente=O.cod_cliente " SQL = SQL & "AND O.ESTADO='APROBADA' " [COLOR=#ff0000] SQL = SQL & "Group BY C.nom_cliente,O.Cod_Cliente,O.Cod_Obra,O.Estado,O.FAprob,P.NoOrden_Pprog,P.CodLote_pprog,L.nom_linea " SQL = SQL & "Order BY O.FAprob,P.NoOrden_Pprog, P.CodLote_pprog"[/COLOR] Db.Open CONSTRING Rs.Open SQL, Db i = 10 While Not Rs.EOF DoEvents Hoja1.Cells(i, 20) = Rs("Nom_Linea") Hoja1.Cells(i, 21) = Rs("descrip_tord") Hoja1.Cells(i, 1) = Rs("Nom_Cliente") 'Obra SQL = "Select Nom_Obra From obra Where Cod_Cliente='" & Rs("Cod_Cliente") & "' and Cod_Obra='" & Rs("Cod_Obra") & "'" Rs3.Open SQL, Db If Not Rs3.EOF Then Hoja1.Cells(i, 2) = Rs3("Nom_Obra") End If Rs3.Close 'ANCHO SQL = "Select Ancho_mm From detalle_pedido Where Cod_Cliente='" & Rs("Cod_Cliente") & "' and no_orden='" & Rs("noorden_pprog") & "'" Rs3.Open SQL, Db If Not Rs3.EOF Then Hoja1.Cells(i, 23) = Rs3("Ancho_mm") End If Rs3.Close 'LARGO '''''''''''''''''' SQL = "Select Largo_mm From detalle_pedido Where Cod_Cliente='" & Rs("Cod_Cliente") & "' and no_orden='" & Rs("noorden_pprog") & "'" Rs3.Open SQL, Db If Not Rs3.EOF Then Hoja1.Cells(i, 24) = Rs3("Largo_mm") End If Rs3.Close 'ITEM '''''''''''''''''' SQL = "Select N_Item From detalle_pedido Where Cod_Cliente='" & Rs("Cod_Cliente") & "' and no_orden='" & Rs("noorden_pprog") & "'" Rs3.Open SQL, Db If Not Rs3.EOF Then Hoja1.Cells(i, 22) = Rs3("N_Item") End If Rs3.Close 'COMPOSICION SQL = "Select Composicion From orden Where Cod_Cliente='" & Rs("Cod_Cliente") & "' and no_orden='" & Rs("noorden_pprog") & "'" Rs3.Open SQL, Db If Not Rs3.EOF Then Hoja1.Cells(i, 25) = Rs3("Composicion") End If Rs3.Close 'M2 Hoja1.Cells(i, 3) = Rs("NoOrden_Pprog") & IIf(Mid(Rs("estado"), 1, 2) = "AP", "", "(" & Mid(Rs("estado"), 1, 2) & ")") Hoja1.Cells(i, 4) = Rs("CodLote_pprog") Hoja1.Cells(i, 5) = Rs("Cantidad") 'Fecha Aprobación If Rs("FAprob") > Rs("Fecha_Pprog") Then Hoja1.Cells(i, 6) = Rs("Fecha_Pprog") Else If Trim(Rs("faprob")) = "" Then Hoja1.Cells(i, 6) = Rs("Fecha_Pprog") Else Hoja1.Cells(i, 6) = Rs("FAprob") End If End If Hoja1.Cells(i, 7) = Rs("FDesp") 'Fecha Programación Hoja1.Cells(i, 8) = Rs("Fecha_Pprog") Hoja1.Cells(i, 14) = DateDiff("d", CDate(Rs("Fecha_Pprog")), Format(Now(), "yyyy/mm/dd")) Hoja1.Cells(i, 17) = DateDiff("d", CDate(Rs("FAprob")), Format(Now(), "yyyy/mm/dd")) 'Fecha Corte SQL = "Select min(Fecha) fechaini From corte " SQL = SQL & "Where No_Lote =" & Rs("CodLote_pprog") & "" Rs3.Open SQL, Db If Not Rs3.EOF Then Hoja1.Cells(i, 9) = Rs3("fechaini") End If Hoja1.Cells(i, 18) = DateDiff("d", CDate(Rs("FAprob")), Rs3("fechaini")) Rs3.Close Hoja1.Cells(i, 12) = CInt(DateDiff("d", CDate(Hoja1.Cells(i, 6)), Format(Now, "YYYY/MM/DD"))) Hoja1.Cells(i, 11) = CInt(DateDiff("d", CDate(Hoja1.Cells(i, 6)), CDate(Hoja1.Cells(i, 8)))) QLote = 0 QTarjeta = 0 QEmpaque = 0 If Rs("noorden_pprog") = "4500017903" Then a = 0 End If SQL = "Select sum(Cantidad)-sum(Empacado) dif from detalle_pedido where cod_cliente='" & Rs("cod_cliente") & "' and no_orden='" & Rs("noorden_pprog") & "'" Rs2.Open SQL, Db If Not Rs2.EOF Then If Rs2("Dif") > 0 Then SQL = "Select Sum(Cantidad),Sum(cantidad)-Sum(empacado) From detalle_lote Where cod_cliente='" & Rs("cod_cliente") & "' and No_Lote=" & Rs("CodLote_pprog") & " and No_Orden= '" & Rs("NoOrden_Pprog") & "'" Rs3.Open SQL, Db If Not Rs3.EOF And Rs3(1) > 0 Then QLote = Rs("Cantidad") SQL = "Select Sum(En_TarjetaEsp) From tarjeta T,detalle_tarjeta DT Where T.Cod_tarjeta=DT.Cod_Tarjeta and T.cod_cliente='" & Rs("cod_cliente") & "' and No_Orden= '" & Rs("NoOrden_Pprog") & "' and No_Lote=" & Rs("CodLote_pprog") & "" 'If InStr(1, Me.cmb_LProd.List(Me.cmb_LProd.ListIndex), "LAMINADO") = 0 Then ' SQL = SQL & " and cod_empaque like 'E%'" 'Else SQL = SQL & " and num_linea=" & Me.List_LProd.List(Me.cmb_LProd.ListIndex) & "" 'End If Rs4.Open SQL, Db If Not Rs4.EOF And Rs4(0) <> "" Then QEmpaque = Rs4(0) Else QEmpaque = 0 End If Rs4.Close Hoja1.Cells(i, 13) = QLote - QEmpaque 'QUERY para Mt2 Faltantes por producir. - Rafa SQL = "Select B.Mt2_Tarjeta,A.Mt2_Lote " _ & "From " _ & "(Select sum(round((dp.ancho_mm*dp.largo_mm)/1000000,2) * pp.cantidad_pprog) Mt2_Lote,dp.cod_cliente,dp.no_orden " _ & "From programacion_prod pp " _ & "Inner Join detalle_pedido dp on dp.cod_cliente=pp.codcliente_pprog and dp.no_orden=pp.noorden_pprog and dp.n_item=pp.nitem_pprog " _ & "Where pp.codcliente_pprog = " & Rs("cod_cliente") & " and pp.noorden_pprog = '" & Rs("NoOrden_Pprog") & "' and pp.codlote_pprog = " & Rs("CodLote_pprog") & " and pp.codlinea_pprog = " & Me.List_LProd.List(Me.cmb_LProd.ListIndex) & " Group by pp.codcliente_pprog,pp.noorden_pprog ) A " _ & "Left Join " _ & "(Select sum(round((dp.ancho_mm*dp.largo_mm)/1000000,2) * en_tarjetaesp) Mt2_Tarjeta, dl.cod_cliente,dl.no_orden " _ & "From detalle_lote dl " _ & "Left Join tarjeta t on t.cod_cliente=dl.cod_cliente and t.no_orden=dl.no_orden " _ & "Left Join detalle_tarjeta dt on dt.cod_tarjeta=t.cod_tarjeta and dt.no_lote=dl.no_lote and dt.no_item=dl.n_item " _ & "Inner Join detalle_pedido dp on dp.cod_cliente=dl.cod_cliente and dp.no_orden=dl.no_orden and dp.n_item=dl.n_item " _ & "Where dl.cod_cliente = " & Rs("cod_cliente") & " and dl.no_orden = '" & Rs("NoOrden_Pprog") & "' and dl.no_lote = " & Rs("CodLote_pprog") & " and num_linea=" & Me.List_LProd.List(Me.cmb_LProd.ListIndex) & " Group by dl.cod_cliente,dl.no_orden) B on A.cod_cliente=B.cod_cliente and A.no_orden=B.no_orden " Rs4.Open SQL, Db If Not Rs4.EOF Then Hoja1.Cells(i, 19) = Rs4(1) - (IIf(IsNull(Rs4(0)), 0, Rs4(0))) Else Hoja1.Cells(i, 19) = 0 End If Rs4.Close If Hoja1.Cells(i, 13) <= 0 Then 'Fecha Ultimo Empaque SQL = "Select max(fecha_actualizacion) UltEmp, sum(en_tarjetaesp) TEmp " SQL = SQL & " From tarjeta e,detalle_tarjeta de " SQL = SQL & " Where e.cod_tarjeta=de.cod_tarjeta and e.cod_cliente='" & Rs("cod_cliente") & "' and de.no_lote=" & Rs("CodLote_pprog") & " and e.no_orden= '" & Rs("NoOrden_Pprog") & "'" Rs4.Open SQL, Db If Not Rs3.EOF Then Hoja1.Cells(i, 12) = CInt(DateDiff("d", CDate(Hoja1.Cells(i, 6)), CDate(Rs4("UltEmp")))) Hoja1.Cells(i, 10) = Rs4("UltEmp") End If Rs4.Close Else cant = 1 If Me.List_LProd.List(Me.cmb_LProd.ListIndex) = 4 Then SQL = "Select count(distinct(codlinea_pprog)) " SQL = SQL & "From programacion_prod P " SQL = SQL & "Where " SQL = SQL & "P.CodLote_pprog<>-1 AND " SQL = SQL & "codcliente_pprog>='" & Rs("cod_cliente") & "' AND " SQL = SQL & "noorden_pprog='" & Rs("noorden_pprog") & "' " Rs4.Open SQL, Db If Not Rs4.EOF Then cant = Rs4(0) End If Rs4.Close End If Select Case cant Case Is = 1 If Hoja1.Cells(i, 12) > 3 Then Hoja1.Cells(i, 1).Interior.Color = &HFF& Hoja1.Cells(i, 2).Interior.Color = &HFF& Hoja1.Cells(i, 3).Interior.Color = &HFF& Hoja1.Cells(i, 4).Interior.Color = &HFF& Hoja1.Cells(i, 5).Interior.Color = &HFF& Hoja1.Cells(i, 6).Interior.Color = &HFF& Hoja1.Cells(i, 7).Interior.Color = &HFF& Hoja1.Cells(i, 8).Interior.Color = &HFF& Hoja1.Cells(i, 9).Interior.Color = &HFF& Hoja1.Cells(i, 10).Interior.Color = &HFF& Hoja1.Cells(i, 11).Interior.Color = &HFF& Hoja1.Cells(i, 12).Interior.Color = &HFF& Hoja1.Cells(i, 13).Interior.Color = &HFF& Hoja1.Cells(i, 15).Interior.Color = &HFF& Hoja1.Cells(i, 10) = "VENCIDO" Else Hoja1.Cells(i, 1).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 2).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 3).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 4).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 5).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 6).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 7).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 8).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 9).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 10).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 11).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 12).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 13).Interior.Color = &HFF& Hoja1.Cells(i, 10) = "NO VENCIDO" End If Case Is > 1 If Hoja1.Cells(i, 12) > 7 Then Hoja1.Cells(i, 1).Interior.Color = &HFF& Hoja1.Cells(i, 2).Interior.Color = &HFF& Hoja1.Cells(i, 3).Interior.Color = &HFF& Hoja1.Cells(i, 4).Interior.Color = &HFF& Hoja1.Cells(i, 5).Interior.Color = &HFF& Hoja1.Cells(i, 6).Interior.Color = &HFF& Hoja1.Cells(i, 7).Interior.Color = &HFF& Hoja1.Cells(i, 8).Interior.Color = &HFF& Hoja1.Cells(i, 9).Interior.Color = &HFF& Hoja1.Cells(i, 10).Interior.Color = &HFF& Hoja1.Cells(i, 11).Interior.Color = &HFF& Hoja1.Cells(i, 12).Interior.Color = &HFF& Hoja1.Cells(i, 13).Interior.Color = &HFF& Hoja1.Cells(i, 17).Interior.Color = &HFF& Hoja1.Cells(i, 10) = "VENCIDO" Else Hoja1.Cells(i, 1).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 2).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 3).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 4).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 5).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 6).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 7).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 8).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 9).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 10).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 11).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 12).Interior.Color = &HD0C0A8 Hoja1.Cells(i, 13).Interior.Color = &HFF& Hoja1.Cells(i, 10) = "NO VENCIDO" End If End Select End If Else 'terminado 'Fecha Ultimo Empaque SQL = "Select max(fecha_actualizacion) UltEmp " SQL = SQL & " From tarjeta e,detalle_tarjeta de " SQL = SQL & " Where e.cod_tarjeta=de.cod_tarjeta and e.cod_cliente='" & Rs("cod_cliente") & "' and de.no_lote=" & Rs("CodLote_pprog") & " and e.no_orden= '" & Rs("NoOrden_Pprog") & "'" Rs4.Open SQL, Db If Not Rs4.EOF And IsNull(Rs4("ultemp")) = False Then Hoja1.Cells(i, 12) = CInt(DateDiff("d", CDate(Hoja1.Cells(i, 6)), CDate(Rs4("UltEmp")))) Hoja1.Cells(i, 10) = Rs4("UltEmp") End If Rs4.Close Hoja1.Cells(i, 13) = QLote - QEmpaque End If Rs3.Close Else 'terminado 'Fecha Ultimo Empaque SQL = "Select max(fecha_actualizacion) UltEmp " SQL = SQL & " From tarjeta e,detalle_tarjeta de " SQL = SQL & " Where e.cod_tarjeta=de.cod_tarjeta and e.cod_cliente='" & Rs("cod_cliente") & "' and de.no_lote=" & Rs("CodLote_pprog") & " and e.no_orden= '" & Rs("NoOrden_Pprog") & "'" Rs4.Open SQL, Db If Not Rs4.EOF And IsNull(Rs4("ultemp")) = False Then Hoja1.Cells(i, 12) = CInt(DateDiff("d", CDate(Hoja1.Cells(i, 6)), CDate(Rs4("UltEmp")))) Hoja1.Cells(i, 10) = Rs4("UltEmp") End If Rs4.Close Hoja1.Cells(i, 13) = QLote - QEmpaque End If End If Rs2.Close 'Si es cero no pasa a la siguiente línea If CStr(Hoja1.Cells(i, 13)) <> 0 Then sLineas = "" SQL = "select nom_linea from linea, orden_linea where cod_linea=codlinea_ola and " _ & "codcliente_ola=" & Rs("Cod_Cliente") & " and noorden_ola='" & Rs("NoOrden_Pprog") & "' " _ & "group by nom_linea order by nom_linea" Rs3.Open SQL, Db While Not Rs3.EOF sLineas = sLineas & "-" & Left(Rs3("nom_linea"), 3) '& IIf(IsNumeric(Right(Rs3("nom_linea"), 1)), Right(Rs3("nom_linea"), 1), "") Rs3.MoveNext Wend Rs3.Close Hoja1.Cells(i, 15) = Right(sLineas, Len(sLineas) - 1) i = i + 1 End If Rs.MoveNext Wend Rs.Close Db.Close If CStr(Hoja1.Cells(i, 13)) = "0" Then Hoja1.Range("A" & i, "U" & i) = "" End If '--------------------------- Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False '------------------------------- UserForm1.Hide End Subel texto sombreado con rojo es el que agrupa los datos, pero al quitar este group by no me aparece nada en la hoja.
les agradezco su atención.
Editado por moderación para envolver código con etiquetas.