Hola
eatoy intentando de hacer el proceso de  la venta de cualquier articulo y de cualquier almacen
en el formulario del almacen puedo hacear cualquier almacen
En el fomulario Frmfacturacionventa selecciono la facturacion y en el menu
de edicion se escoje nueva venta y va al formulario FrmCompra que es para vebta
hay un menu de buacr almaceb dentro del almacen hay abrir almacen y cerrar almacen
cuando digo abrir almacen me pone los datos en el list1. hasta ahi todo bien


https://workupload.com/file/YDzEPkjcWju



me faltaria pasar datos del liat1 a los text y hacer el proceso de venta para cada articuko

gracias

Hola
estoy intentando de leer la informacion del archivo almacen.regdata que esta en el directorio almacen al list1 y no lo consigo
tengo error en el proceso listar
aqui el archivo



https://workupload.com/file/Xd6GygBshTR


gracias

Hola
tengo un problema a la hora de imprimir varias hojas me hace el listado seguido
hago el siguiente calculo

 
 
 If i = 24 Then    
 
 
Printer.NewPage
 
 encabezado
End If
 
 

no logro que me cambie de hoja

 
 
Private Sub imprimir()
' Imprimir
 
'Imprimir
Dim BeginPage As Long, EndPage As Long, NumCopies As Long, Orientation As Long, Tell As Long
Dim i As Integer
Dim fuente As StdFont
Set fuente = Printer.Font
'Set fuente = Printer.Font
CommonDialog1.CancelError = True
 
On Error GoTo ErrHandler
 
 
 
CommonDialog1.Flags = &H40&
   CommonDialog1.ShowPrinter
 
 
BeginPage = CommonDialog1.FromPage
   EndPage = CommonDialog1.ToPage
   NumCopies = CommonDialog1.Copies
 
 
  Printer.Orientation = CommonDialog1.Orientation
 
 
  With Printer
   If .Orientation = 1 Then
        .Orientation = vbPRORPortrait
    Else
        .Orientation = vbPRORLandscape
    End If
 
  End With
 
 
On Error Resume Next
 
Dim numCols As Integer
    Dim filas As Long
 
 
encabezado
 
 
    listarcolumnas
 
 
   If i = 24 Then    
 
 
Printer.NewPage
 
 encabezado
End If
 
 
 
 
 
 
 
 
Printer.Print
 
 
 
 
Set Printer.Font = fuente
 
 
 Printer.EndDoc
' Set Printer.Font = fuente
 Exit Sub
 
ErrHandler:
' El usuario hizo clic en el botón Cancelar.
Exit Sub
 
 
End Sub
 
Private Sub listarcolumnas()
Dim AnchoPapel As Integer
    Dim MargenIzquierdo As Integer
    Dim numCols As Integer
    Dim filas As Long
    Dim ultimafila As Long
    Dim k As Long, j As Long, i As Integer, n As Integer, anchocol As Integer
    Dim linea As String
    Dim margen As Integer
    Dim fuente As StdFont
 
 
    Set fuente = Printer.Font
    numCols = 9
    Printer.FontName = "Courier New"  ' una fuente monoespaciada, si no el trabajo es más laborioso...
    filas = ((List1.ListCount + 1) \ numCols)
    ultimafila = ((List1.ListCount + 1) Mod numCols) ' columnas que tendrá la última fila.
    anchocol = ((AnchoPapel - MargenIzquierdo) \ numCols)
 
 
    For k = 0 To filas - 1
        n = margen
        For i = 0 To numCols - 1
            Printer.CurrentX = n  ' imprime el texto de la columna 'i'
            Printer.Print List1.List(j + i)
            n = (n + anchocol)
        Next
 
        j = (j + numCols)
        Printer.CurrentY = (Printer.CurrentY + Printer.TextHeight("t"))  ' el textheight depende de la fuente seleccionada en la impresora, no importa el texto entre paréntesis... es fijo para la  fuente.
    Next
 
    If (ultimafila > 0) Then ' la última fila tiene 1 o más columnas, pero menos que 'numcols'.
        n = margen
        For i = 0 To ultimafila - 1
            Printer.CurrentX = n  ' imprime el texto de la columna 'i'
            Printer.Print List1.List(j + i)
            n = (n + anchocol)
        Next
    End If
 
    Set Printer.Font = fuente
End Sub
Private Sub encabezado()
Printer.Font.Name = "Courier"
Printer.Font.Size = 10
Printer.FontBold = True
 
Printer.Print Tab(5); "HORA: " & UCase(Format(Now, "hh:mm ")); Tab(80); "Fecha:"; Date
 
 
 
 
 
 
 
Printer.Font.Name = "Arial"
Printer.Font.Size = 10
Printer.FontBold = True
 
Printer.DrawWidth = 10
Printer.DrawStyle = 2
 
 
 
 
Printer.CurrentX = 4000
Printer.CurrentY = 0
Printer.Print "Listado de Almacen"
 
 
 
 
Printer.CurrentY = 1000
Printer.CurrentX = 200: Printer.Print "Codigo"
Printer.CurrentY = 1000
Printer.CurrentX = 1000: Printer.Print "Stock"
Printer.CurrentY = 1000
Printer.CurrentX = 2900: Printer.Print "Articulo"
Printer.CurrentY = 1000
Printer.CurrentX = 5000: Printer.Print "Precio"
Printer.CurrentY = 1000
Printer.CurrentX = 6000: Printer.Print "Impuesto"
Printer.CurrentY = 1000
Printer.CurrentX = 7200: Printer.Print "Uds.Caja"
Printer.CurrentY = 1000
Printer.CurrentX = 8300: Printer.Print "Umbral"
Printer.CurrentY = 1000
Printer.CurrentX = 9500: Printer.Print "Pedido"
Printer.CurrentY = 1000
Printer.CurrentX = 10500: Printer.Print "En Oferta"
 
 
End Sub
 
 
 
 
 

gracias

Hola
estoy tratando de acabar el programa de Facturacion que tengo dos problemas
en el formulario almacen todo funciona bien

1:cuando cargo los datos de un almacen con el combo del formulario venta los carga bien por primera vez, cuando cargo otro almecen no me lo carga al combo del formulario venta

2:en el formulario compra tendria que ver un combo para dichos articulos de compra del formulario de almacen, para poder hacer dicha compra del articulo.

aqui te dejo el archivo que tengo hasta ahora


https://workupload.com/archive/6DYH2KtENe

lo de subir el archivo no se si lo he hecho bien, si sale bien veras dos archivos iguales


gracias

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




gracias

Hola necesito imprimir varias paginas  con numero de pagina

en la facturacion de venta

el problema esta en cuanto imprimo lo hace todo seguido y hay un formato, cuando llega al final de la hoja y pasa a la siguiente el formato no lo hace
subo el ejemplo


https://workupload.com/file/4XXRNywJuA8

gracias

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

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

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

estoy haciendo un pequeño programa con el cual hay unos datos fijos y quisiera poner esos datos en el grafico circular hay cuatro datos pero hay un quinto dato que falta dibujar  que es la variable z1 en el grafico y poner el dato en el grafico.

en el programa faltaria controlar el indice de introducir los datos que empezara por 1,2,3,4,5, etc


el ejemplo que tengo hasta ahora es el siguiente:

 
 
Option Explicit
Private Type departamento
 d As Date
 w As Double
 x As Double
 y As Double
 z As Double
 zl As Double
 End Type
 
Dim dpto As departamento
Dim NumRecs As Long
 
Private Sub Command1_Click()
'Grafico
DrawPie
End Sub
 
Private Sub DrawPiePiece(lColor As Long, ByVal fStart As Double, ByVal fEnd As Double)
  Const PI As Double = 3.14159265359
  Const CircleEnd As Double = -2 * PI
  Dim dStart As Double
  Dim dEnd As Double
 
  Picture2.FillColor = lColor
  Picture2.FillStyle = 0
  dStart = fStart * (CircleEnd / 100)
  dEnd = fEnd * (CircleEnd / 100)
  Picture2.Circle (170, 150), 100, , dStart, dEnd
End Sub
 
Private Sub DrawPie()
  Dim Disp As Single, Alq As Single, i As Byte, Vt As Integer, Ang1 As Single, Ang2 As Single
 
  Picture2.Cls
 
  Picture2.AutoRedraw = True
  Picture2.BackColor = &H8000000E
  Picture2.ScaleMode = vbPixels
 
 
  Dim xx As Double
  Dim yy As Double
  Dim zz As Double
  Dim uu As Double
 
 
  With dpto
    If .w = 0 Then MsgBox "No hay registros para" & DateTime.Date & "para ser mostrado"
        Text1.Text = .d
        If .w > 0 Then
        xx = (.x * 100) / .w
        yy = xx + (.y * 100) / .w
        zz = yy + (.z * 100) / .w
        uu = zz + (.zl * 100) / .w
 
        Call DrawPiePiece(QBColor(1), 0.001, xx)
        Call DrawPiePiece(QBColor(6), xx, yy)
        Call DrawPiePiece(QBColor(3), yy, zz)
        Call DrawPiePiece(QBColor(5), zz, uu)
    End If
 
  End With
End Sub
 
Private Sub Command2_Click()
'Guardar
 With dpto
      .d = Date
      .w = 650
      .x = 301
      .y = 39
      .z = 109
      .zl = 201
    End With
 
    NumRecs = 1
    Open App.Path & "\PieData.dat" For Random As #1 Len = 64
      Put #1, 1, NumRecs
      Put #1, NumRecs + 1, dpto
    Close #1
End Sub
 
Private Sub Command3_Click()
'Leer
If FileLen(App.Path & "\PieData.dat") > 60 Then
    Open App.Path & "\PieData.dat" For Random As #1 Len = 64
      Get #1, 1, NumRecs
      Get #1, NumRecs + 1, dpto
    Close #1
    DrawPie
  End If
End Sub
 
Private Sub Command4_Click()
End
End Sub
 
Private Sub Command5_Click()
Picture2.Cls
End Sub
 
 
 
 

gracias