Título: Problema con bucle Publicado por: mdg en 20 Noviembre 2007, 22:02 pm Buenas muchachos, esperon puedan ayudarme.
Tengo por un lado una funcion que me genera numeros de recibos: Public Function NumeroRecibo() 'Funcion para generar los nuevos numeros de legajo 'Determinamos cual es la liuidacion actualmente activa 'Dlookup es una funcion personalizada tambien con el mismo fin 'que la de access. Dim Vperiodo As Single Vperiodo = Dlookup("liquidacion", "tbl_info", "liquidacion>" & 0, "") On Error GoTo Hay_err_err Dbpath = App.Path & "\bases\Base_actual.mdb" strSQL = "SELECT max(id)as resultado FROM tbl_liquidacion WHERE periodo=" & Vperiodo Set Db = DBEngine.OpenDatabase(Dbpath, False, False, ";pwd=" & StrPass) Set Rst = Db.OpenRecordset(strSQL) Rst.MoveFirst Rst.MoveLast If IsNull(Rst!Resultado) Then NumeroRecibo = 1 Else NumeroRecibo = Rst!Resultado + 1 End If Hay_err_exit: Rst.Close Db.Close Set Rst = Nothing Set Db = Nothing Hay_err_err: Select Case Err.Number Case 3024 MsgBox "Es imposible encontrar la base de datos. " & vbCrLf & vbCrLf & "Verifique que exista o que se encuentre en la ruta:" & App.Path & "\bases" & " e intente nuevamente", vbInformation + vbOKOnly, "Aviso!" Exit Function Case 3078 MsgBox "Es imposible encontrar la tabla: " & vbCrLf & vbCrLf & "Verifique que exista o que se encuentre en la base de datos" & "Base_Actual.mdb" & "e intente nuevamente", vbInformation + vbOKOnly, "Aviso!" Exit Function End Select End Function Por otro lado tango un control list view donde añado multiples items de multiples empleados y lo que pretendo es lo siguiente: recibo legajo empleado 1 10 perez 1 10 perez 1 10 perez 2 11 gomez 2 11 gomez 2 11 gomez el asunto es que no se como hacer para que por cada legajo repetido me repita el numero de recibo. El codigo que utilizo para cargar el listview es el siguiente: Private Sub Command2_Click() On Error GoTo Hay_err_err Dim i As Integer Dim o As Integer Dim item As ListItem Dim cantidad As Integer Dim Grupo As Integer Dim concepto As Currency Dim Formula_Concepto As String Dim Formula_Cantidad As String Dim Publica_cantidad As Integer With ListView3 .SortKey = idconcepto .Sorted = True End With With ListView3 .SortKey = idlegajo .Sorted = True End With If (Me.ListView1.ListItems.Count = 0) Then MsgBox "No hay ningún concepto cargado en la lista", vbInformation Exit Sub End If If (Me.ListView2.ListItems.Count = 0) Then MsgBox "No hay ningún empleado cargado en la lista", vbInformation Exit Sub End If For i = 1 To Me.ListView3.ListItems.Count For o = 1 To Me.ListView1.ListItems.Count 'para evitar que se ingresen varios conceptos iguales If Me.ListView3.ListItems.item(i).SubItems(1) = Me.ListView1.ListItems.item(i) Then MsgBox "El/Los conceptos seleccionados" & vbCrLf & vbCrLf & "ya se encuentra cargado, no es posible repitir los conceptos", vbInformation + vbOKOnly, "Error" Exit Sub Else End If Next o Next i 'Me.ListView3.ListItems.Clear For i = 1 To Me.ListView1.ListItems.Count 'Cantidad de conceptos Formula_Concepto = Dlookup("formula_concepto", "tbl_conceptos", "codigo=" & Me.ListView1.ListItems.item(i), "") Formula_Cantidad = Dlookup("formula_cantidad", "tbl_conceptos", "codigo=" & Me.ListView1.ListItems.item(i), "") 'Establecemos el grupo para insertarlo en la columna correspondiente Grupo = Dlookup("grupo", "Tbl_Conceptos", "codigo=" & Me.ListView1.ListItems.item(i), "") 'Publica cantidad Publica_cantidad = Dlookup("publica_cantidad", "Tbl_Conceptos", "codigo=" & Me.ListView1.ListItems.item(i), "") For o = 1 To Me.ListView2.ListItems.Count 'Establecemos las variables de concepto y cantidad, o sea traemos la fomrula 'Evaluamos el resultado de las variables Formula_concepto y Formula_cantidad concepto = o_Script.Eval(Formula_Concepto) cantidad = o_Script.Eval(Formula_Cantidad) Set item = Me.ListView3.ListItems.Add(, , Me.ListView2.ListItems.item(o)) item.ListSubItems.Add(1) = Me.ListView1.ListItems.item(i) item.ListSubItems.Add(2) = Me.ListView1.ListItems.item(i).ListSubItems.item(1) item.ListSubItems.Add(3) = "" item.ListSubItems.Add(4) = "" item.ListSubItems.Add(5) = "" item.ListSubItems.Add(6) = "" item.ListSubItems.Add(7) = Me.ListView1.ListItems.item(i).ListSubItems.item(2) item.ListSubItems.Add(8) ='ACA ES DONDE NECESITO CARGAR EL NUMERO DEL RECIBO Next o Next i Hay_err_exit: Hay_err_err: Select Case Err.Number Case 1002 MsgBox "La fomula es inevaluable" & vbCrLf & vbCrLf & "Verifique el contenido e intente nuevamente", vbInformation + vbOKOnly, "Aviso!" End Select End Sub Gracias por su ayuda de antemano... |