Operaciones con ListView 6.00 VBA
Diseñamos un userform y escribimos el siguiente código:
Public stridentidad As String
Public intindex As Integer
Private Sub UserForm_Initialize()
On Error GoTo Errores
PersonalizarListView
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub txtclave_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo Errores
If KeyCode = 114 Then
Me.txtrecibido.BackColor = RGB(94, 255, 51)
Me.txtrecibido.Enabled = True
Me.txtrecibido.SetFocus
End If
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub txtcantidad_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsNumeric(Me.txtcantidad.Text) Or Me.txtcantidad.Value = 0 Then
Cancel = True
Me.txtcantidad.SetFocus
MsgBox "Capture una cantidad", vbOKOnly + vbInformation, "Cantidad"
End If
End Sub
Private Sub txtcantidad_Change()
On Error Resume Next
If Me.txtcantidad.Text > 0 Then Me.cmdagregar.Enabled = True
If Me.txtcantidad.Text <> 0 Then Me.cmdagregar.Enabled = False
ImportePartida
On Error GoTo 0
End Sub
Private Sub txtcantidad_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo Errores
If KeyCode = 13 Then
AgregarPartida
End If
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub txtprecio_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsNumeric(Me.txtprecio.Text) Or Me.txtprecio.Value = 0 Then
Cancel = True
Me.txtprecio.SetFocus
MsgBox "Capture un precio", vbOKOnly + vbInformation, "Cantidad"
End If
End Sub
Private Sub txtprecio_Change()
On Error Resume Next
If Me.txtprecio.Text > 0 Then Me.cmdagregar.Enabled = True
If Me.txtprecio.Text <> 0 Then Me.cmdagregar.Enabled = False
ImportePartida
On Error GoTo 0
End Sub
Private Sub txtprecio_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo Errores
If KeyCode = 13 Then
AgregarPartida
End If
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub txtdescuento_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsNumeric(Me.txtdescuento.Text) Then
Cancel = True
Me.txtdescuento.SetFocus
MsgBox "Capture un descuento", vbOKOnly + vbInformation, "Descuento"
End If
End Sub
Private Sub txtdescuento_Change()
On Error Resume Next
ImportePartida
On Error GoTo 0
End Sub
Private Sub txtdescuento_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo Errores
If KeyCode = 13 Then
AgregarPartida
End If
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub cmdagregar_Click()
AgregarPartida
End Sub
Private Sub cmdeliminar_Click()
On Error GoTo Errores
EliminarPartida
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub cmdnuevo_Click()
Me.ListView1.ListItems.Clear
Me.cmdagregar.Enabled = False
Me.cmdeliminar.Enabled = False
Me.cmdnuevo.Enabled = False
Me.cmdguardar.Enabled = False
Me.cmdbuscar.Enabled = False
Me.cmdactualizar.Enabled = False
End Sub
Private Sub cmdguardar_Click()
Dim lngultfil As Long
Dim intfila As Integer
Dim ws As Worksheet
On Error GoTo Errores
If MsgBox("¿Los datos son correctos?", vbYesNo + vbQuestion, "Antes de continuar") = vbNo Then MsgBox "No se guardó nada", vbOKOnly + vbExclamation, "Exclamation": Exit Sub
Set ws = Worksheets("Hoja1")
'1ra forma recorrer partidas en un ListView
For intfila = 1 To Me.ListView1.ListItems.Count
lngultfil = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ws.Cells(lngultfil, 1).Value = lngultfil - 1
ws.Cells(lngultfil, 2).Value = Me.ListView1.ListItems(intfila).ListSubItems(2)
ws.Cells(lngultfil, 3).Value = Me.ListView1.ListItems(intfila).ListSubItems(3)
ws.Cells(lngultfil, 4).Value = Me.ListView1.ListItems(intfila).ListSubItems(4)
ws.Cells(lngultfil, 5).Value = Me.ListView1.ListItems(intfila).ListSubItems(5)
ws.Cells(lngultfil, 6).Value = Me.ListView1.ListItems(intfila).ListSubItems(6)
ws.Cells(lngultfil, 7).Value = Me.ListView1.ListItems(intfila).ListSubItems(7)
ws.Cells(lngultfil, 8).Value = Me.ListView1.ListItems(intfila).ListSubItems(8)
ws.Cells(lngultfil, 9).Value = "VIGENTE"
Next intfila
MsgBox "El registro fue guardado correctamente", vbOKOnly + vbInformation, "Información"
Me.ListView1.ListItems.Clear
Me.cmdnuevo.Enabled = True
Me.cmdguardar.Enabled = False
Me.cmdbuscar.Enabled = True
Me.cmdactualizar.Enabled = False
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub cmdbuscar_Click()
Dim lngultfil As Long
Dim intfila As Integer
Dim lstItem As ListItem
Dim ws As Worksheet
On Error GoTo Errores
Me.ListView1.ListItems.Clear
Set ws = Worksheets("Hoja1")
lngultfil = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row - 1
'1ra forma
For intfila = 2 To lngultfil
If ws.Cells(intfila, 9) = "VIGENTE" Then
Set lstItem = Me.ListView1.ListItems.Add(Text:=0)
lstItem.ListSubItems.Add Text:=ws.Cells(intfila, 1)
lstItem.ListSubItems.Add Text:=ws.Cells(intfila, 2)
lstItem.ListSubItems.Add Text:=FormatNumber(ws.Cells(intfila, 3), 3)
lstItem.ListSubItems.Add Text:=ws.Cells(intfila, 4)
lstItem.ListSubItems.Add Text:=ws.Cells(intfila, 5)
lstItem.ListSubItems.Add Text:=FormatNumber(ws.Cells(intfila, 6), 4)
lstItem.ListSubItems.Add Text:=FormatNumber(ws.Cells(intfila, 7), 2)
lstItem.ListSubItems.Add Text:=FormatNumber(ws.Cells(intfila, 8), 2)
End If
Next intfila
RealizarSuma
Me.cmdnuevo.Enabled = True
Me.cmdguardar.Enabled = False
Me.cmdbuscar.Enabled = False
Me.cmdactualizar.Enabled = True
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub cmdactualizar_Click()
Dim intide As Integer
Dim rng1 As Range
On Error GoTo Errores
'Poner cancelado a las partidas eliminadas de ListView
For intide = 1 To intcontador
Set rng1 = Hoja1.Range("A:A").Find(What:=stridepartid(intide), LookAt:=xlWhole, LookIn:=xlValues)
If rng1 Is Nothing Then
MsgBox "El id no existe", vbOKOnly + vbInformation, "No encontrado"
Else
Hoja1.Range("I" & rng1.Row) = "CANCELADO"
End If
Next intide
intcontador = 0
'Agregamos o modificamos los registros
'2da forma recorrer filas en ListView
Dim rngrango As Range
Dim intfila As Integer
Dim lngultfil As Long
Dim strpartid As String
With Sheets("Hoja1")
For intfila = 1 To Me.ListView1.ListItems.Count
strpartid = Me.ListView1.ListItems.Item(intfila).SubItems(1)
'Buscar registro
Set rng1 = Hoja1.Range("A:A").Find(What:=strpartid, LookAt:=xlWhole, LookIn:=xlValues)
If rng1 Is Nothing Then
'Si no existe el registro lo da de alta
Set rngrango = Sheets("Hoja1").Range("A1").CurrentRegion
lngultfil = rngrango.Rows.Count + 1
.Cells(lngultfil, 1).Value = lngultfil - 1
.Cells(lngultfil, 2).Value = Me.ListView1.ListItems.Item(intfila).SubItems(2)
.Cells(lngultfil, 3).Value = Me.ListView1.ListItems.Item(intfila).SubItems(3)
.Cells(lngultfil, 4).Value = Me.ListView1.ListItems.Item(intfila).SubItems(4)
.Cells(lngultfil, 5).Value = Me.ListView1.ListItems.Item(intfila).SubItems(5)
.Cells(lngultfil, 6).Value = Me.ListView1.ListItems.Item(intfila).SubItems(6)
.Cells(lngultfil, 7).Value = Me.ListView1.ListItems.Item(intfila).SubItems(7)
.Cells(lngultfil, 8).Value = Me.ListView1.ListItems.Item(intfila).SubItems(8)
.Cells(lngultfil, 9).Value = "VIGENTE"
Else
'Si existe el registro lo modifica
Hoja1.Range("C" & rng1.Row) = Me.ListView1.ListItems.Item(intfila).SubItems(3)
Hoja1.Range("F" & rng1.Row) = Me.ListView1.ListItems.Item(intfila).SubItems(6)
Hoja1.Range("G" & rng1.Row) = Me.ListView1.ListItems.Item(intfila).SubItems(7)
Hoja1.Range("H" & rng1.Row) = Me.ListView1.ListItems.Item(intfila).SubItems(8)
End If
Next intfila
End With
MsgBox "El registro fué actualizado", vbOKOnly + vbInformation, "Información"
'Poner cancelado a las partidas eliminadas
Me.cmdnuevo.Enabled = True
Me.cmdguardar.Enabled = False
Me.cmdbuscar.Enabled = True
Me.cmdactualizar.Enabled = False
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub txtrecibido_Change()
On Error Resume Next
If Not IsNumeric(Me.txtrecibido.Value) Then Exit Sub
If Me.txtrecibido.Text > 0 Then Me.txtcambio.Text = Format(Me.txtrecibido.Text - Me.txttotalfin.Text, "##,##0.00")
On Error GoTo 0
End Sub
Private Sub txtrecibido_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo Errores
If KeyCode = 13 Then
Call cmdguardar_Click
End If
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With ListView1
If .SortOrder = lvwAscending Then
.SortOrder = lvwDescending
Else
.SortOrder = lvwAscending
End If
.Sorted = True
.SortKey = 1
End With
End Sub
Private Sub ListView1_DblClick()
On Error GoTo Errores
If Me.ListView1.ListItems.Count = 0 Then Exit Sub
intindex = Me.ListView1.SelectedItem.Index
'1ra forma
With Me.ListView1
Me.txtidenti.Text = .SelectedItem.SubItems(1)
Me.txtclave.Value = .SelectedItem.SubItems(2)
Me.txtcantidad.Value = .SelectedItem.SubItems(3)
Me.txtunidad.Value = .SelectedItem.SubItems(4)
Me.txtnombre.Value = .SelectedItem.SubItems(5)
Me.txtprecio.Value = .SelectedItem.SubItems(6)
Me.txtdescuento.Value = .SelectedItem.SubItems(7)
Me.txtimporte.Value = .SelectedItem.SubItems(8)
End With
'2da forma
Me.txtidenti.Text = Me.ListView1.SelectedItem.ListSubItems(1)
Me.txtclave.Text = Me.ListView1.SelectedItem.ListSubItems(2)
Me.txtcantidad.Text = FormatNumber(Me.ListView1.SelectedItem.ListSubItems(3), 3)
Me.txtunidad.Text = Me.ListView1.SelectedItem.ListSubItems(4)
Me.txtnombre.Text = Me.ListView1.SelectedItem.ListSubItems(5)
Me.txtprecio.Text = FormatNumber(Me.ListView1.SelectedItem.ListSubItems(6), 4)
Me.txtdescuento.Text = FormatNumber(Me.ListView1.SelectedItem.ListSubItems(7), 2)
Me.txtimporte.Text = FormatNumber(Me.ListView1.SelectedItem.ListSubItems(8), 2)
'3ra forma
With Me.ListView1
Me.txtidenti.Text = .SelectedItem.ListSubItems.Item(1)
Me.txtclave.Value = .SelectedItem.ListSubItems.Item(2)
Me.txtcantidad.Value = .SelectedItem.ListSubItems.Item(3)
Me.txtunidad.Value = .SelectedItem.ListSubItems.Item(4)
Me.txtnombre.Value = .SelectedItem.ListSubItems.Item(5)
Me.txtprecio.Value = .SelectedItem.ListSubItems.Item(6)
Me.txtdescuento.Value = .SelectedItem.ListSubItems.Item(7)
Me.txtimporte.Value = .SelectedItem.ListSubItems.Item(8)
End With
Me.txtclave.Enabled = False
Me.txteditar.Text = "SI"
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub ListView1_AfterLabelEdit(Cancel As Integer, NewString As String)
Me.ListView1.SelectedItem.SubItems(3) = NewString
Cancel = True
RealizarSuma
End Sub
Private Sub PersonalizarListView()
'1ra forma encabezados de ListView
With Me.ListView1
.ListItems.Clear
.ColumnHeaders.Add(, , "", 0, lvwColumnLeft).Tag = "STRING"
.ColumnHeaders.Add(, , "Id", 20, lvwColumnLeft).Tag = "STRING"
.ColumnHeaders.Add(, , "Código", 60, lvwColumnLeft).Tag = "STRING"
.ColumnHeaders.Add(, , "Cantidad", 60, lvwColumnRight).Tag = "NUMBER"
.ColumnHeaders.Add(, , "Unidad", 50, lvwColumnRight).Tag = "NUMBER"
.ColumnHeaders.Add(, , "Nombre", 150, lvwColumnLeft).Tag = "STRING"
.ColumnHeaders.Add(, , "Precio", 70, lvwColumnRight).Tag = "NUMBER"
.ColumnHeaders.Add(, , "Descue", 50, lvwColumnRight).Tag = "NUMBER"
.ColumnHeaders.Add(, , "Importe", 70, lvwColumnRight).Tag = "NUMBER"
.ColumnHeaders.Add(, , "", 0, lvwColumnLeft).Tag = "STRING"
.Font.Size = 11
End With
'2da forma encabezados de ListView
With Me.ListView1
.ListItems.Clear
.Font.Size = 11
With .ColumnHeaders
.Clear
.Add Text:="", Width:=0, Alignment:=fmAligmentLeft
.Add Text:="Id", Width:=20, Alignment:=fmAligmentLeft
.Add Text:="Código", Width:=60, Alignment:=fmAligmentLeft
.Add Text:="Cantidad", Width:=60, Alignment:=lvwColumnRight
.Add Text:="Unidad", Width:=50, Alignment:=fmAligmentLeft
.Add Text:="Nombre", Width:=150, Alignment:=fmAligmentLeft
.Add Text:="Precio", Width:=70, Alignment:=lvwColumnRight
.Add Text:="Descue", Width:=50, Alignment:=lvwColumnRight
.Add Text:="Importe", Width:=70, Alignment:=lvwColumnRight
.Add Text:="", Width:=0, Alignment:=lvwColumnLeft
End With
End With
'Visualización de los datos en forma de reporte
Me.ListView1.View = lvwReport
'Visualizar Líneas
Me.ListView1.Gridlines = True
'Resaltar Fila al Seleccionarla
Me.ListView1.FullRowSelect = True
'Edita la celda de forma automática
Me.ListView1.LabelEdit = lvwAutomatic
'Borde del control
Me.ListView1.Appearance = ccFlat
End Sub
Private Sub AgregarPartida()
Dim lngiden As Long
Dim strclav As String
Dim intfila As Integer
Dim lstItem As ListItem
On Error GoTo Errores
If Not IsNumeric(Me.txtcantidad.Text) Then Exit Sub
If Not IsNumeric(Me.txtdescuento.Text) Then Exit Sub
If Not IsNumeric(Me.txtprecio.Text) Then Exit Sub
If Me.txtcantidad.Text = 0 Then Exit Sub
If Me.txtprecio.Text = 0 Then Exit Sub
If Me.txteditar.Text = "SI" Then
'1ra forma editar partida
'For intfila = 1 To Me.ListView1.ListItems.Count
' lngiden = Me.ListView1.ListItems.Item(intfila).SubItems(1)
' If lngiden = Me.txtidenti.Text Then
' Me.ListView1.ListItems.Item(intfila).SubItems(3) = FormatNumber(Me.txtcantidad.Text, 3)
' Me.ListView1.ListItems.Item(intfila).SubItems(6) = FormatNumber(Me.txtprecio.Text, 4)
' Me.ListView1.ListItems.Item(intfila).SubItems(7) = FormatNumber(Me.txtdescuento.Text, 2)
' Me.ListView1.ListItems.Item(intfila).SubItems(8) = FormatNumber(Me.txtimporte.Text, 2)
' End If
'Next intfila
'2da forma editar partida
Me.ListView1.ListItems.Item(intindex).SubItems(3) = FormatNumber(Me.txtcantidad.Text, 3)
Me.ListView1.ListItems.Item(intindex).SubItems(6) = FormatNumber(Me.txtprecio.Text, 4)
Me.ListView1.ListItems.Item(intindex).SubItems(7) = FormatNumber(Me.txtdescuento.Text, 2)
Me.ListView1.ListItems.Item(intindex).SubItems(8) = FormatNumber(Me.txtimporte.Text, 2)
Else
GenerarCadena
'1ra forma agregar partida
Set lstItem = Me.ListView1.ListItems.Add(, , 0)
lstItem.SubItems(1) = stridentidad
lstItem.SubItems(2) = Me.txtclave.Text
lstItem.SubItems(3) = FormatNumber(Me.txtcantidad.Text, 3)
lstItem.SubItems(4) = Me.txtunidad.Text
lstItem.SubItems(5) = Me.txtnombre.Text
lstItem.SubItems(6) = FormatNumber(Me.txtprecio.Text, 4)
lstItem.SubItems(7) = FormatNumber(Me.txtdescuento.Text, 2)
lstItem.SubItems(8) = FormatNumber(Me.txtimporte.Text, 2)
'2da forma agregar partida
'Set lstItem = Me.ListView1.ListItems.Add(Text:=0)
'lstItem.ListSubItems.Add Text:=stridentidad
'lstItem.ListSubItems.Add Text:=Me.txtclave.Text
'lstItem.ListSubItems.Add Text:=Format(Me.txtcantidad.Value, "##,##0.000")
'lstItem.ListSubItems.Add Text:=Me.txtunidad.Value
'lstItem.ListSubItems.Add Text:=Me.txtnombre.Value
'lstItem.ListSubItems.Add Text:=Format(Me.txtprecio.Value, "##,##0.0000")
'lstItem.ListSubItems.Add Text:=Format(Me.txtdescuento.Value, "##,##0.00")
'lstItem.ListSubItems.Add Text:=Format(Me.txtimporte.Value, "##,##0.00")
End If
Me.txtidenti.Text = 0
Me.txteditar.Text = "NO"
Me.txtclave.Enabled = True
RealizarSuma
Me.txtclave.SetFocus
Me.txtclave.Text = Clear
Me.txtcantidad.Text = 0
Me.txtunidad.Text = Empty
Me.txtnombre.Text = Empty
Me.txtprecio.Text = 0
Me.txtdescuento.Text = 0
Me.txtimporte.Text = 0
If Me.ListView1.ListItems.Count >= 1 Then Me.cmdguardar.Enabled = True: Me.cmdeliminar.Enabled = True: Me.cmdbuscar.Enabled = False
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub EliminarPartida()
Dim intcont As Integer
On Error GoTo Errores
'1ra forma
If Me.ListView1.ListItems.Count <> 0 Then
'Tomamos la partida para ponerle CANCELADO
intcontador = intcontador + 1
ReDim Preserve stridepartid(intcontador) As String
stridepartid(intcontador) = Me.ListView1.SelectedItem.ListSubItems(1)
'Elimina la partida de ListView
Me.ListView1.ListItems.Remove Me.ListView1.SelectedItem.Index
Else
MsgBox "No hay nada que eliminar", vbInformation, "Eliminar"
End If
'2da forma
'If Me.ListView1.ListItems.Count = 0 Then Me.cmdguardar.Enabled = False: Exit Sub
'intcont = Me.ListView1.SelectedItem.Index
'Me.ListView1.ListItems.Remove (intcont)
If Me.ListView1.ListItems.Count = 0 Then
Me.cmdagregar.Enabled = True
Me.cmdeliminar.Enabled = False
Me.cmdguardar.Enabled = False
Me.cmdbuscar.Enabled = False
Me.cmdactualizar.Enabled = False
End If
RealizarSuma
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub ImportePartida()
Dim curprecio As Currency
On Error GoTo Errores
If Not IsNumeric(Me.txtcantidad.Text) Then Me.cmdagregar.Enabled = False
If Not IsNumeric(Me.txtdescuento.Text) Then Me.cmdagregar.Enabled = False
If Not IsNumeric(Me.txtprecio.Text) Then Me.cmdagregar.Enabled = False
If Me.txtcantidad.Text = 0 Then Me.cmdagregar.Enabled = False
If Me.txtprecio.Text = 0 Then Me.cmdagregar.Enabled = False
If Me.txtdescuento.Text = 0 Then Me.cmdagregar.Enabled = False
If Me.txtcantidad.Text > 0 Then Me.cmdagregar.Enabled = True
If Me.txtprecio.Text > 0 Then Me.cmdagregar.Enabled = True
curprecio = Format(Me.txtprecio.Text - (Me.txtprecio.Text * (Me.txtdescuento.Text / 100)), "##,##0.0000")
Me.txtimporte.Text = Format(Me.txtcantidad.Text * curprecio, "##,##0.0000")
Errores:
If Err.Number <> 0 Then
Me.txtimporte.Text = 0
End If
End Sub
Private Sub RealizarSuma()
Dim intfila As Integer
Dim cur_cantid As Currency
Dim cur_precio As Currency
Dim cur_descue As Currency
Dim curimporte As Currency
Dim cur_cantfi As Currency
Dim cur_total As Currency
Dim curdescuen As Currency
Dim curtotalfi As Currency
On Error GoTo Errores
cur_total = 0
curdescuen = 0
curtotalfi = 0
For intfila = 1 To Me.ListView1.ListItems.Count
cur_cantid = 0: cur_precio = 0: cur_descue = 0: curimporte = 0
cur_cantid = Format(Me.ListView1.ListItems(intfila).ListSubItems(3), "##,##0.0000")
cur_precio = Format(Me.ListView1.ListItems(intfila).ListSubItems(6), "##,##0.0000")
cur_descue = Format(Me.ListView1.ListItems(intfila).ListSubItems(7), "##,##0.0000")
curimporte = Format(Me.ListView1.ListItems(intfila).ListSubItems(8), "##,##0.0000")
cur_cantfi = cur_cantfi + cur_cantid
cur_total = cur_total + (cur_cantid * cur_precio)
curdescuen = curdescuen + (cur_cantid * (cur_precio * (cur_descue / 100)))
curtotalfi = cur_total - curdescuen
Next intfila
Me.txttotal.Text = Format(cur_total, "##,##0.00")
Me.txtdescuent.Text = Format(curdescuen, "##,##0.00")
Me.txttotalfin.Text = Format(curtotalfi, "##,##0.00")
Me.lblregistros.Caption = "TOTAL DE PARTIDAS " & Me.ListView1.ListItems.Count
Me.lblarticulos.Caption = "TOTAL DE ARTICULOS " & Format(cur_cantfi, "##,##0.00")
Errores:
If Err.Number <> 0 Then
MsgBox "Se ha producido un error" & vbNewLine & "Error número: " & Err.Number & vbNewLine & "Descripción: " & Err.Description & "", vbOKOnly + vbExclamation, "Error"
End If
End Sub
Private Sub GenerarCadena()
Dim intcont As Integer
Dim strcaracteres As String
strcaracteres = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
For intcont = 1 To 10
stridentidad = stridentidad & Mid(strcaracteres, Int((Len(strcaracteres) * Rnd) + 1), 1)
Next intcont
End Sub
Insertamos un Módulo y escribimos:
Public stridepartid() As String
Public intcontador As Integer
En la hoja1 de trabajo escribimos los que se muestra:
En Hoja1 se registra la información
No hay comentarios.:
Publicar un comentario