| |
|
31
|
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
|
|
|
|
|
32
|
Programación / Programación Visual Basic / Re: Guardar list2 y leer list1
|
en: 1 Mayo 2022, 14:18 pm
|
Ahora crea el nuevo almacen, pero no logro que me lea el almacen Private Sub mnualmacen_Click(Index As Integer) 'Crear Nuevo Almacen Dim File As String Select Case Index Case 0 ' Nuevo Almacen File = InputBox("Elija el nombre del fichero para una nuevo Almacen (no debe existir).", "Nuevo Almacen", "Nuevo Almacen.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 nuevo Almacen abortado. No se proporcionó un nombre", vbInformation, "Nuevo Almacen") End If Case 1 ' Leer Nuevo Almacen 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 Private Function CrearNuevaFacturacion(ByRef NombreFile As String) As Boolean Dim Ruta As String If (Abierto = True) Then Call Cerrar(Canal) Ruta = (App.Path & "\" & NombreFile) If (Abrir(Ruta, Canal, True) = True) Then Call UpdateHeader(0, 0) CrearNuevaFacturacion = True Else MsgBox "Parece que el fichero que intenta abrir ya existe, elija otro nombre (o bien ocurrió un error)..." End If End Function Private Function LeerFacturacion(ByRef Ruta As String) As Boolean Dim k As Integer If (Abierto = True) Then Call Cerrar(Canal) If (Abrir(Ruta, Canal) = True) Then Get #Canal, 1, NumRegistros Get #Canal, , AutoIncLote Get #Canal, , AutoIncProducto If (NumRegistros > 0) Then With List1 .Clear For k = 1 To NumRegistros Get #Canal, , RegX Call .AddItem(RegCompraToString(RegX, CHAR_SEP)) Next ' Ahora si se quiere puede leerse de nuevo el primer registro para transferirlo a los textbox... .ListIndex = 0 ' para ello delegamos en el código que pondremos al listbox... End With End If LeerFacturacion = True End If End Function
el problema esta en esta linea Call .AddItem(RegCompraToString(RegX, CHAR_SEP)) error byref argument type mismatch en RegX gracias
|
|
|
|
|
38
|
Programación / Programación Visual Basic / Re: poner tanto por ciento en el grafico circular
|
en: 31 Marzo 2022, 22:01 pm
|
he mejorado el codigo del grafico ahora introduzco los datos fijos y los lee solo quisiera poner el porcentaje en el grafico circular el codigo es el siguiente Option Explicit Private Type departamento d As Date x As Double y As Double z As Double w As Double End Type Dim dpto As departamento Dim NumRecs As Long Private Sub Command1_Click() 'Grafico DrawPie End Sub Private Sub DrawPie() Const PI As Double = 3.14159265359 Dim x1 As Double, y1 As Double, z1 As Double, w1 As Double Dim x As Double, y As Double, z As Double, w As Double Dim r As Double, midx As Double, midy As Double Dim sum As Double 'Text1.Text = Format$(Date, "dd/mm/yyyy") Picture2.Cls Picture2.FillStyle = 0 x1 = Val(Text2.Text) y1 = Val(Text3.Text) z1 = Val(Text4.Text) w1 = Val(Text5.Text) sum = x1 + y1 + z1 + w1 x = x1 / sum y = y1 / sum z = z1 / sum w = w1 / sum midx = Picture2.Width / 2 midy = Picture2.Height / 2 r = Picture2.Width / 2 - 300 If x <> 0 And y <> 0 And z <> 0 Then Picture2.FillColor = vbRed Picture2.Circle (midx, midy), r, , -2 * PI, -2 * PI * x, 2 / 3 Picture2.FillColor = vbYellow Picture2.Circle (midx, midy), r, , -2 * PI * x, -2 * PI * (x + y), 2 / 3 Picture2.FillColor = vbBlue Picture2.Circle (midx, midy), r, , -2 * PI * (x + y), -2 * PI * (x + y + z), 2 / 3 Picture2.FillColor = vbGreen Picture2.Circle (midx, midy), r, , -2 * PI * (x + y + z), -2 * PI, 2 / 3 End If End Sub Private Sub Command2_Click() 'Guardar With dpto .d = Text1.Text .x = Val(Text2.Text) .y = Val(Text3.Text) .z = Val(Text4.Text) .w = Val(Text5.Text) End With NumRecs = 1 Open App.Path & "\PieData.dat" For Random As #1 Len = Len(dpto) 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 = Len(dpto) Get #1, 1, NumRecs Get #1, NumRecs + 1, dpto With dpto Text1.Text = .d Text2.Text = Val(.x) Text3.Text = Val(.y) Text4.Text = Val(.z) Text5.Text = Val(.w) End With Close #1 DrawPie 'End If End Sub Private Sub Command4_Click() End End Sub Private Sub Command5_Click() Picture2.Cls Text2.SetFocus End Sub Private Sub Form_Load() Text1.Text = Format$(Date, "dd/mm/yyyy") End Sub
Gracias
|
|
|
|
|
39
|
Programación / Programación Visual Basic / poner tanto por ciento en el grafico circular
|
en: 30 Marzo 2022, 12:30 pm
|
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
|
|
|
|
|
|
| |
|