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

Hola soy corlo

estoy haciendo un formulario menu mdi principal aqui no hay problema
cuando hago el primer menu fichero no hay problema
pero cuando hago el segundo menu  clientes los botones de nuevo, editar,eliminar,imprimir me van al formulario mdi
hay alguna manera de que los botones me vaya al menu clientes con su respectivo codigo.
si voy haciendo mas menus los botones de los respectivos menus me van ha ir al formulario principal mdi y todo el codigo tambien.
gracias

Hola soy corlo

ahora en pantalla principal hay list1 y list2

en el list2 es donde se va entrando los articulos desde el formulario y en el list1 es donde se guardan los datos del list2 al list1 para poder sumar el contado y tarjeta de credito

A la hora de entrar los datos al list2 desde el formulario lo hace bien, el problema es para guardar todos los datos del list2 a una fila del list1 asi sucesivamente con numero de ticket 1,2,3, etc del list1


a la hora de guardar seria:Command2_click()

N de ticket, fecha y hora, metodo de pago, total en el list1


en el metodo de pago esta en la pantalla principal no desde el formulario




a la hora de leer seria list1_click()
N ticket, Fecha y hora, Producto, Precio Unitario, cantidad, subtotal, total, en el list2



Gracias

Hola soy colro

necesito sumar el total contado y el total tarjeta de credito
 consigo sumar el total del list1
pongo el codigo

 
Case 1  ' Leer fichero de facturación
            FrmFile.Show 1
            Dim h As Integer
             Dim totalcontado As Integer
                Dim totaltcredito As Integer
                totalcontado = 0: totaltcredito = 0
            If (Len(FrmFile.File) > 0) Then
                If (LeerFacturacion(App.Path & "\" & FrmFile.File) = True) Then
                    Call Activar(True)
 
                    For h = 0 To List1.ListCount - 1
 
                     If reg2.MetodoDePago = "0" Then
                     totalcontado = totalcontado + Val(Split(List1.List(h), vbTab)(6))
                    End If
                    If reg2.MetodoDePago = "1" Then
                    totaltcredito = totaltcredito + Val(Split(List1.List(h), vbTab)(6))
                    End If
                    Next h
                    txttotal.Text = Format(totalcontado, "#,##0.00")
                    Txttotal1.Text = Format(totaltcredito, "#,##0.00")
 
                Else
                    Call Activar(False)
                End If
            End If
 
 
 

Gracias

Hola soy corlo

estoy haciendo una mini aplicacion de guardar datos de factura y leerlos por pantalla, en archivo secuencial.

guardar datos lo hace bien

el problema esta en leer los datos de la factura en pantalla
el archivo es 1.txt y hay lo siguiente:


==============================
           COMPROBANTE DE VENTA
==============================
TICKET Nº: 1                    TIPO : CONTADO
FECHA : 20/11/2021          HORA : 20:30:59
-------------------------------------------------------
R.U.C/C.I : a
CLIENTE   : a
===============================
CANTIDAD  PRODUCTO     PRECIO       SUBTOTAL
===============================
12               r              8          96
3              k              1.5        4,5
===============================
              TOTAL :                           100,50
               -------------------------------------------

          GRACIAS POR SU COMPRA!



me sale todo mezclado


el código que tengo hasta ahora es el siguiente:

 
Option Explicit
 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_SETTABSTOPS = &H192
 Dim I As Integer
 Dim orden As Integer 'numero de ticket
 Dim fecha As Date 'para leer la fecha
 Dim hora As Date 'para leer la hora
 Dim contado As String 'para contado
 Dim credito As String 'para  credito
 Dim cedu1 As String ' para el RUC/C.I
 Dim nom1 As String ' para el cliente
 'abajo son datos del list1
 Dim cantidad As Integer
Dim producto As String * 12
Dim preciox As String * 8
Dim subtot As Double
'varible del total
Dim tot As Double
Private Sub Command4_Click()
End
End Sub
 
Private Sub Command5_Click()
'Nuevo registro
 '//recuperar el dato.
Open App.Path & "\Numero1.txt" For Input As #1
Do While Not EOF(1)
Input #1, orden
Loop
Close #1
Txtnum = orden + 1
 
 
 
      List1.Clear
     txtCedula1.Text = ""
     txtNombre1.Text = ""
     total.Text = ""
     txtCedula1.SetFocus
 
 
End Sub
 
 
 
Private Sub Command6_Click()
'Guardar Factura
 
Dim cantidadtotal As Double
 Dim k As Integer
 
 
orden = Txtnum.Text
On Error GoTo salir
 
 
 
 
 
    Open App.Path & "\Numero1.txt" For Append As #1
 
    Print #1, Txtnum
    Close #1
 
Dim bmx As String
bmx = App.Path + "\" + Txtnum + ".txt"
 
  Open bmx For Append As #1
 
 
  Txtnum = orden
 
 
 
    Print #1,
 
    Print #1,
 
    Print #1,
 
 
    Print #1, Tab(1); String(44, "=")
    Print #1, Tab((44 - Len("COMPROBANTE DE VENTA")) \ 2); "COMPROBANTE DE VENTA"
    Print #1, Tab(1); String(44, "=")
 
    If Option1.Value = True Then
        Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CONTADO")); "TIPO : CONTADO"
    Else
        Print #1, Tab(1); "TICKET Nº: " & Txtnum.Text; Tab(44 - Len("TIPO : CREDITO")); "TIPO : CREDITO"
    End If
 
    Print #1, Tab(1); "FECHA : " & Date; Tab(44 - Len("HORA : " & Time)); "HORA : " & Time
 
    Print #1, Tab(1); String(44, "-")
 
    Print #1, Tab(1); "R.U.C/C.I : " & txtCedula1.Text
    Print #1, Tab(1); "CLIENTE   : " & txtNombre1.Text
 
    Print #1, Tab(1); String(44, "=")
    Print #1, Tab(1); "CANTIDAD"; Tab(11); "PRODUCTO"; Tab(24); "PRECIO"; Tab(37); "SUBTOTAL"
    Print #1, Tab(1); String(44, "=")
 
 
For k = 0 To List1.ListCount - 1
Print #1, List1.List(k)
Next k
 
 
 
    Print #1, Tab(1); String(44, "=")
    Print #1, Tab(15); "TOTAL : "; Tab(43 - Len(Format(total.Text, "#,##0.00"))); Format(total.Text, "#,##0.00")
    Print #1, Tab(16); "-----------------------------"
 
 
 
    Print #1,
    Print #1, Tab((44 - Len("GRACIAS POR SU COMPRA!")) \ 2); "GRACIAS POR SU COMPRA!"
 
    For I = 1 To 10
        Print #1,
    Next I
 
    Close #1
 
 
  Option1.Value = False
Option2.Value = False
 
 txtCedula1.Text = ""
 txtNombre1.Text = ""
    List1.Clear
cant.Text = ""
prod.Text = ""
precio.Text = ""
subtotal.Text = ""
total.Text = ""
cant.SetFocus
 
    Exit Sub
 
salir:
 
Dim msgb
 
msgb = MsgBox("Error Nº : [ " & Err.Number & " ]" & " " & Err.Description, vbOKCancel + vbInformation)
 
 
End Sub
 
 
 
Private Sub Command7_Click()
'Leer Factura
Dim tabs(0 To 3) As Long
    tabs(0) = 20
    tabs(1) = 60
    tabs(2) = 95
    tabs(3) = 138
    ' Set the tabs.
    SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1)
 
 
 
Dim str As String
Dim thj As String
Dim plo As Boolean
Dim j As Integer
Dim h As Integer
On Error GoTo lo
List1.Clear
thj = App.Path + "\" + Txtnum.Text + ".txt"
If Dir(thj) <> "" Then
Open thj For Input As #1
 
Input #1, orden
Txtnum.Text = orden
Input #1, fecha
Label4.Caption = fecha
Input #1, hora
Label5.Caption = hora
Input #1, contado
Input #1, credito
 
Input #1, cedu1, nom1
 
txtCedula1.Text = cedu1
txtNombre1.Text = nom1
 
While Not EOF(1)
 
Input #1, cantidad, producto, preciox, subtot
cant.Text = cantidad
prod.Text = producto
precio.Text = preciox
subtotal.Text = subtot
List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot
Wend
 
j = 0
   For h = 0 To List1.ListCount - 1
j = j + Val(Split(List1.List(h), vbTab)(3))
Next h
total.Text = j
 
 
 
Close #1
End If
 
If contado= contado Then
Option1.Value = True
Else
 
If credito = credito Then
Option2.Value = True
 
End If
End If
 
 
 
 
 
Exit Sub
lo:
If Not plo = True Then
MsgBox "La Factura no existe, gracias", vbCritical
End If
End Sub
 
Private Sub Command8_Click()
'Agregar
Dim h As Integer
Dim j As Double
 
cantidad = cant.Text
producto = prod.Text
preciox = precio.Text
subtot = subtotal.Text
 
List1.AddItem cantidad & vbTab & producto & vbTab & preciox & vbTab & subtot
j = 0
   For h = 0 To List1.ListCount - 1
j = j + Split(List1.List(h), vbTab)(3)
Next h
total.Text = Format(j, "#,##0.00")
cant.Text = ""
prod.Text = ""
precio.Text = ""
subtotal.Text = ""
cant.SetFocus
End Sub
 
Private Sub Form_Load()
Dim tabs(0 To 3) As Long
 
    tabs(0) = 20
    tabs(1) = 123
    tabs(2) = 237
    tabs(3) = 370
 
    SendMessage List1.hwnd, LB_SETTABSTOPS, 4, tabs(1)
 
Option1.Value = False
Option2.Value = False
 
Open App.Path & "\Numero1.txt" For Append As #1
Close #1
Open App.Path & "\Numero1.txt" For Append As #1
Close #1
 
 '//recuperar el dato.
Open App.Path & "\Numero1.txt" For Input As #1
Do While Not EOF(1)
Input #1, orden
Loop
Close #1
Txtnum = orden + 1
 
End Sub
 
Private Sub List1_Click()
Text1.Text = Mid(List1.Text, 1, InStr(1, List1.Text, " ") - 1)
Text2.Text = Mid(List1.Text, InStr(1, List1.Text, " ") + 1)
I = List1.ListIndex
End Sub
 
 
 
 
 
 
Private Sub Option1_Click()
Option2.Value = False
End Sub
 
Private Sub Option2_Click()
Option1.Value = False
End Sub
 
Private Sub precio_KeyUp(KeyCode As Integer, Shift As Integer)
 subtotal.Text = cant.Text * Val(precio.Text)
End Sub
 
Private Sub Timer1_Timer()
Label4.Caption = Date
Label5.Caption = Format(Time, "hh:mm:ss")
End Sub
 
 
 

Gracias

Hola soy corlo
estoy haciendo una mini aplicacion en añadir datos a los textbox ,  para luego leer los datos con el combo y una opcion para eliminar los datos.

añadir los datos: lo hace bien
leer los datos: lo hace bien
eliminar los datos: elimina el dato en el combo pero no elimina los datos de los textbox
no se que hago mal
paso el codigo que tengo hasta ahora

en un formulario





y en un modulo







gracias

Hola soy  corlo


estoy haciendo un pequeño programa necesito descontar el valor que le pongo en el  text3.text
y lo cambie en el valor seleccionado del list1 de la columna 3


en el programa hay los siguientes objetos:

1 list1
1 list2

text1.text
text2.text
text3.text

1 command1 salida
1 command4 ok

la cuestion es que cuando aprieto el command1 la operacion de resta lo hace bien, cuando voy a el command4 no consigo poner el resultado del text3.text  en el list1 del valor seleccionado de la columna 3

aqui esta el codigo que tengo hasta ahora:



he probado varias formas pero no consigo cambiar el valor del text3 al list1

gracias

Hola soy corlo
tengo el siguiente problema

cuando pongo lo siguiente en el apartado leer user y password

Text1.Text = Access.uname
Text2.Text = Access.passwd

el problema es cuando estoy leyendo el user y password introduzca datos diferentes en el text1.text y el text2.text , y pongo los datos que hay en fichero  siempre me dice bienbenido y va al form2

en cambio cuando quito


Text1.Text = Access.uname
Text2.Text = Access.passwd


siempre me dice El archivo no existe


Aqui pongo el codigo





la pregunta seria:

como solucionar el tema de los avisos en el apartado leer

1. para ir al formulario dos

2. para el registro no existe


Gracias

Hola soy Corlo
Mi problema es el siguiente:
Cuando lo hago por pantalla me lo hace bien

en un commandbutton1




Pero cuando lo hago por impresora, no me  hace nada

intento hacer esto:



pero no sale, he buscado por internet y no encuentro la solucion, gracias

Hola soy corlo
tengo una duda para imprimir list1

el codigo que tengo hasta ahora es el siguiente



la impresion lo hace bien


como puedo hacer las separaciones del list1 a la hora de imprimir las columnas
el list1 tiene 4 columnas

ReDim lbtab(1 To 4) As Long

lbtab(1) = 31
lbtab(2) = 141
lbtab(3) = 278
lbtab(4) = 478
SendMessageArray List1.hwnd, LB_SETTABSTOPS, 4, lbtab(1)