|
21
|
Programación / Programación Visual Basic / Re: Problema de array
|
en: 12 Junio 2024, 20:23 pm
|
Hola Serapis He hecho tu codigo y pongo 20 en el form load me sale valor negativo y no sale el valor que tiene que salir 38760 y si pongo 19 entonces sale 27132 y sale bien en el text1.terxt y en el list1 no salen las combinaciones de 6 numeros Option Explicit Private SizeArray As Integer Private Valores() As Byte Private Function GetArrayDeValores(ByVal Cantidad As Byte) As Byte() Dim V() As Byte, v18() As String Const Val18 As String = "4, 6, 14, 18, 19, 20, 21, 24, 26, 27, 31, 32, 35, 36, 40, 41, 42, 47, 49" Const Val19 As String = 33 Const Val20 As String = 11 Dim i As Integer Dim k As Integer If ((Cantidad < 18) Or (Cantidad > 20)) Then MsgBox "No se ha contemplado el caso de un array con " & CStr(Cantidad) & " de ítems... " & vbCrLf & "Valores aceptados actualmente: 18-20" SizeArray = 0 Else v18 = Split(Val18, ", ") ' pasamos la constante a un array de strings ReDim V(0 To Cantidad - 1) ' dimsnesionamos el array en la cantidad deseada For k = 0 To 18 ' pasamos los 18 valores del array de strings al array de bytes V(k) = CByte(v18(k)) Next If (Cantidad >= 19) Then V(18) = Val19 ' Si se solicitó 19 o 20 valores, pasamos el 19º If (Cantidad = 20) Then V(19) = Val20 ' ídem para el 20º SizeArray = Cantidad GetArrayDeValores = V ' devolvemos el array al tamaño solicitado y con los valores asignados. End If End Function
Private Sub CombinacionesDe6(ByVal Cantidad As Byte) Dim Max As Integer, combinacion As String Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, n As Integer Valores = GetArrayDeValores(Cantidad) If (SizeArray > 0) Then List1.Clear List1.Visible = False ' Esto hará que el añadido sea mucho más rápido Max = UBound(Valores) For i = 0 To Max - 5 For j = i + 1 To Max - 4 For k = j + 1 To Max - 3 For l = k + 1 To Max - 2 For m = l + 1 To Max - 1 For n = m + 1 To Max '.... lo que sea que vayas a hacer... por ejemplo añadirlos al listbox combinacion = ConcatValues(CStr(Valores(i)), CStr(Valores(j)), CStr(Valores(k)), CStr(Valores(l)), CStr(Valores(m)), CStr(Valores(n))) List1.AddItem combinacion Next Next Next Next Next Next List1.Visible = True Text1.Text = List1.ListCount ' el añadido es bastante rápido, no hace falta ponerlo más que al final, o en todo caso en un bucle previo (si fueran a meterse muchos miles) End If End Sub Private Function ConcatValues(i As String, j As String, k As String, l As String, m As String, n As String) As String ConcatValues = Format2Digitos(i) & Format2Digitos(j) & Format2Digitos(k) & Format2Digitos(l) & Format2Digitos(m) & Format2Digitos(n) End Function ' Formato: 2espacios + valor(2 dígitos) + espacio(s) + separador Private Function Format2Digitos(ByRef Valor As String, Optional ByVal Size As Byte = 8, Optional ByRef Separador As String = "|") As String Dim Salida As String, k As Integer Dim ConcatValues As String If (Len(Valor) = 1) Then Salida = (" 0" & Valor) Else Salida = (" " & Valor) End If k = (Len(Salida) + Len(Separador) - Size) If (k > 0) Then Salida = Salida & Space$(k) ConcatValues = (Salida & Separador) End Function
Private Sub Form_Load() CombinacionesDe6 20 End Sub
|
|
|
22
|
Programación / Programación Visual Basic / Problema de array
|
en: 12 Junio 2024, 13:44 pm
|
Hola estoy haciendo una aplicacion de loteria que en el array solo me acepta 19 numeros ¿como puedo hacer que el array me acepte 20 numeros o mas? en el text1.text hay el total de las apuestas el tect5.text esta la fecha actual en el list1 estan todas las apuestas del text1.text Option Explicit
Private Sub MakeUniqueCombinationOfSix(AryOfWhat() As Variant)
On Error GoTo MakeUniqueCombinationOfSixError
Dim NCnt1 As Integer, NCnt2 As Integer, NCnt3 As Integer Dim NCnt4 As Integer, NCnt5 As Integer, NCnt6 As Integer Dim UpperBoundsOfArray As Integer, LowerBoundsOfArray As Integer List1.Clear UpperBoundsOfArray = UBound(AryOfWhat) LowerBoundsOfArray = LBound(AryOfWhat)
For NCnt1 = LowerBoundsOfArray To UpperBoundsOfArray For NCnt2 = NCnt1 + 1 To UpperBoundsOfArray For NCnt3 = NCnt2 + 1 To UpperBoundsOfArray For NCnt4 = NCnt3 + 1 To UpperBoundsOfArray For NCnt5 = NCnt4 + 1 To UpperBoundsOfArray For NCnt6 = NCnt5 + 1 To UpperBoundsOfArray List1.AddItem AryOfWhat(NCnt1) & "," & AryOfWhat(NCnt2) & "," & _ AryOfWhat(NCnt3) & "," & AryOfWhat(NCnt4) & "," & _ AryOfWhat(NCnt5) & "," & AryOfWhat(NCnt6) Text1.Text = List1.ListCount Next NCnt6 Next NCnt5 Next NCnt4 Next NCnt3 Next NCnt2 Next NCnt1
Exit Sub MakeUniqueCombinationOfSixError:
MsgBox "MakeUniqueCombinationOfSix " & Err.Number & ":" & Err.Description
End Sub
Private Sub Form_Load() Text5.Text = Date Randomize Dim A() As Variant A = Array(4, 6, 14, 18, 19, 20, 21, 24, 26, 27, 31, 32, 35, 36, 40, 41, 42, 47, 49) MakeUniqueCombinationOfSix A End Sub
gracias
|
|
|
24
|
Programación / Programación Visual Basic / apertura y cierre de saldo
|
en: 4 Octubre 2022, 12:50 pm
|
Hola Serapis
he conseguido arreglar el programa de facturacion o sea ahora puedo hacer compras y ventas, bueno el de compras estaba practicamente eho, he tenido que hacer el de ventas. funciona todo bien
ahora solo faltaria hacer apertura de saldo y cierre para cada dia, un ejemplo una idea con codigo yo ya lo adaptaria.
muchas gracias
|
|
|
26
|
Programación / Programación Visual Basic / problema con hacer el carrito de almacen
|
en: 13 Julio 2022, 13:48 pm
|
hola serapis estoy intentando de hacer el carrito de la compra de facturacion, pero lo quiero adaptar para hacer el carrito de articulos de almacen para poder comprar, Editar y eliminar articulos, para control de varios almacenes.
el menu principal seria
archivo = crear almacen, abrir almacen, cerrar almacen
edicion = comprar articulos, editar articulo, eliminar articulos
en el list1 seria
Codigo Stock Articulo impuesto Uda.caja Umbral Pedido En Oferta
seria de mucha utilidad si me pudiese hacer la version del formulario frmalmacen
seria hacer el carrito de la compra de articulos
me hago un lio con las funciones el programa no para de darme errores
muchas gracias
|
|
|
27
|
Programación / Programación Visual Basic / Re: leer archivo combo
|
en: 6 Junio 2022, 22:18 pm
|
Hola Serapis
no se si estoy mal fijado o no
si se abre un archivo de facturacion los articulos que hay en dicha facturacion van al combo del formulario frmcompra para poder ir comprando articulos para la facturacion, si no que sentido hay en hacer crear facturacion y leer facturacion
gracias
|
|
|
28
|
Programación / Programación Visual Basic / Re: leer archivo combo
|
en: 5 Junio 2022, 21:58 pm
|
gracias por responder serapis
se supone que el elhacker.net es un foro para hacer preguntas de visual basic 6.0
solo me falta este punto de programacion para solucionar, ya no hare mas preguntas gracias
|
|
|
29
|
Programación / Programación Visual Basic / leer archivo combo
|
en: 5 Junio 2022, 15:20 pm
|
tengo un pequeño problema del programa Facturacion a la hora de crear nueva facturacion va bien a la hora de leer la informacion parece que lee pero no me lee la informacion en el formulario frmcompra del combo donde tiene que ir los articulos de leer la facturacion. si yo creo varias facturaciones siempre en combo me lee la misma facturacion el codigo del combo es el siguiente Private Sub CmbArticulo_Click() Dim Id As Integer If (CmbArticulo.ListIndex >= 0) Then Id = CmbArticulo.ItemData(CmbArticulo.ListIndex) RegArt = FrmAlmacen.ArticuloByCode(Id) With RegArt TxtUnidades.Text = CStr(.UnidadesPorCaja) Call EstablecerValorImpuestos(.PrecioUnitario, .ImpuestoIVA) If (.IdOferta > 0) Then LabOferta.Caption = "¿Está en oferta?: SI" Id = FrmOfertas.BuscarPorCodigo(.IdOferta, RegOfer) Else LabOferta.Caption = "¿Está en oferta?: NO" TxtDescuento.Text = "- 0.0" Call VaciarRegOferta End If End With Call Totalizar End If End Sub
como puedo leer si son diferentes facturaciones y que vaya al combo del formulario frmcompra gracias
|
|
|
30
|
Programación / Programación Visual Basic / Re: Guardar list2 y leer list1
|
en: 1 Mayo 2022, 18:07 pm
|
Hola serapis he hecho los cambios y ahora me dice error en crearnuevafacturacion Private Sub mnualmacen_Click(Index As Integer) 'Crear Nuevo Almacen Dim File As String Select Case Index Case 0 ' Nueva facturación File = InputBox("Elija el nombre del fichero para una nueva facturacón (no debe existir).", "Nueva Facturacion", "Nueva facturacion.dat") If (Len(File) > 0) Then File = AsegurarExtension(File, FILE_EXTENSION_FACTURA) If (CrearNuevaFacturacion(File) = True) Then Call Activar(True) Else Call Activar(False) End If Else Call MsgBox("Proceso de creación de nueva facturación abortado. No se proporcionó un nombre", vbInformation, "Nueva facturación") End If Case 1 ' Leer fichero de facturación Frmfile1.Show 1 If (Len(Frmfile1.File) > 0) Then If (LeerFacturacion(App.Path & "\" & Frmfile1.File) = True) Then Call Activar(True) Else Call Activar(False) End If End If End Select End Sub
If (CrearNuevaFacturacion(File) = True) Then error argument not opcional en CrearNuevaFacturacion(file) gracias
|
|
|
|
|
|
|