Public cod, art, mar, pv, ctr, creg
Sub muestra1()
UserForm2.Show
End Sub
Código que se inserta en un formulario
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
Set a = Sheets("Articulos")
filaedit = a.Range("A" & Rows.Count).End(xlUp).Row + 1
fila = Me.ListBox1.ListIndex
'a.Cells(filaedit, "A") = ListBox1.List(fila, 0)
'a.Cells(filaedit, "B") = ListBox1.List(fila, 1)
'a.Cells(filaedit, "C") = ListBox1.List(fila, 2)
'a.Cells(filaedit, "D") = ListBox1.List(fila, 3)
'a.Cells(filaedit, "E") = ListBox1.List(fila, 4)
'a.Cells(filaedit, "F") = ListBox1.List(fila, 5)
'a.Cells(filaedit, "G") = ListBox1.List(fila, 6)
'a.Cells(filaedit, "H") = ListBox1.List(fila, 7)
'a.Cells(filaedit, "I") = ListBox1.List(fila, 8)
cod = ListBox1.List(fila, 1)
art = ListBox1.List(fila, 2)
mar = ListBox1.List(fila, 3)
pv = ListBox1.List(fila, 8)
End If
Unload UserForm1
UserForm3.Show
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Articulos")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
Me.ListBox1.Clear
'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
'Me.ListBox1.RowSource = "Hoja2!A2:H" & uf
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
' strg = b.Cells(i, 4).Value
'If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
' End If
Next i
'Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets("Articulos").Cells(1, ii + 1)
Next ii
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
strg = b.Cells(i, 3).Value
If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
End If
Next i
'Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets("Articulos").Cells(1, ii + 1)
Next ii
'Me.ListBox1.ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets("Articulos")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = "" Then
Me.ListBox1.Clear
'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
'Me.ListBox1.RowSource = "Hoja2!A2:H" & uf
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
' strg = b.Cells(i, 4).Value
'If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
' End If
Next i
'Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets("Articulos").Cells(1, ii + 1)
Next ii
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
strg = b.Cells(i, 4).Value
If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
End If
Next i
'Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets("Articulos").Cells(1, ii + 1)
Next ii
End Sub
Private Sub UserForm_Initialize()
Dim fila As Long
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Articulos")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
.ColumnCount = 9
.ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt;60pt"
'.RowSource = "Hoja2!A1:" & wc & uf
End With
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
' strg = b.Cells(i, 4).Value
'If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
' End If
Next i
'Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets("Articulos").Cells(1, ii + 1)
Next ii
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub
Código que se inserta en un formulario
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
Set a = Sheets("Articulos")
filaedit = a.Range("A" & Rows.Count).End(xlUp).Row + 1
fila = Me.ListBox1.ListIndex
'a.Cells(filaedit, "A") = ListBox1.List(fila, 0)
'a.Cells(filaedit, "B") = ListBox1.List(fila, 1)
'a.Cells(filaedit, "C") = ListBox1.List(fila, 2)
'a.Cells(filaedit, "D") = ListBox1.List(fila, 3)
'a.Cells(filaedit, "E") = ListBox1.List(fila, 4)
'a.Cells(filaedit, "F") = ListBox1.List(fila, 5)
'a.Cells(filaedit, "G") = ListBox1.List(fila, 6)
'a.Cells(filaedit, "H") = ListBox1.List(fila, 7)
'a.Cells(filaedit, "I") = ListBox1.List(fila, 8)
cod = ListBox1.List(fila, 1)
art = ListBox1.List(fila, 2)
mar = ListBox1.List(fila, 3)
pv = ListBox1.List(fila, 8)
End If
Unload UserForm1
UserForm3.Show
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Articulos")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
Me.ListBox1.Clear
'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
'Me.ListBox1.RowSource = "Hoja2!A2:H" & uf
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
' strg = b.Cells(i, 4).Value
'If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
' End If
Next i
'Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets("Articulos").Cells(1, ii + 1)
Next ii
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
strg = b.Cells(i, 3).Value
If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
End If
Next i
'Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets("Articulos").Cells(1, ii + 1)
Next ii
'Me.ListBox1.ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets("Articulos")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = "" Then
Me.ListBox1.Clear
'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
'Me.ListBox1.RowSource = "Hoja2!A2:H" & uf
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
' strg = b.Cells(i, 4).Value
'If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
' End If
Next i
'Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets("Articulos").Cells(1, ii + 1)
Next ii
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
strg = b.Cells(i, 4).Value
If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
End If
Next i
'Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets("Articulos").Cells(1, ii + 1)
Next ii
End Sub
Private Sub UserForm_Initialize()
Dim fila As Long
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Articulos")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
.ColumnCount = 9
.ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt;60pt"
'.RowSource = "Hoja2!A1:" & wc & uf
End With
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem
For i = 2 To uf
' strg = b.Cells(i, 4).Value
'If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
' End If
Next i
'Carga los datos de la cabecera en listbox
For ii = 0 To 9
UserForm1.ListBox1.List(0, ii) = Sheets("Articulos").Cells(1, ii + 1)
Next ii
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub
Código que se inserta en un formulario
Private Sub CommandButton1_Click()
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
If UserForm2.ListBox1.ListCount = 0 Or TextBox1 = Empty Or TextBox3 = Empty Then
MsgBox "Debe llenar fecha, cliente y seleccionar por lo menos un articulo antes de guardar en la base de datos", vbCritical, "AVISO"
Exit Sub
End If
Set a = Sheets("DbFac")
uf = a.Range("A" & Rows.Count).End(xlUp).Row + 1
For x = 0 To UserForm2.ListBox1.ListCount - 1
a.Cells(uf, "A") = Val(UserForm2.Label2.Caption)
a.Cells(uf, "B") = UserForm2.TextBox3
a.Cells(uf, "C") = UserForm2.Label3.Caption
a.Cells(uf, "D") = UserForm2.TextBox1
a.Cells(uf, "E") = UserForm2.TextBox2
a.Cells(uf, "F") = UserForm2.ListBox1.List(x, 0)
a.Cells(uf, "G") = UserForm2.ListBox1.List(x, 1)
a.Cells(uf, "H") = UserForm2.ListBox1.List(x, 2)
a.Cells(uf, "I") = CDec(UserForm2.ListBox1.List(x, 3))
a.Cells(uf, "J") = CDec(ListBox1.List(x, 5))
uf = uf + 1
Next x
UserForm2.TextBox1 = Clear
UserForm2.TextBox2 = Clear
UserForm2.TextBox3 = Clear
UserForm2.ListBox1.Clear
uf = Sheets("DbFac").Range("A" & Rows.Count).End(xlUp).Row
Nfac = Application.WorksheetFunction.Max(Sheets("DbFac").Range("A2" & ":A" & uf + 1)) + 1
Label2.Caption = Format(Nfac, "00000000")
End Sub
Private Sub CommandButton3_Click()
UserForm1.Show
End Sub
Private Sub CommandButton4_Click()
Application.ScreenUpdating = False
On Error Resume Next
If UserForm2.ListBox1.ListCount = 0 Or TextBox1 = Empty Or TextBox3 = Empty Then
MsgBox "Debe llenar fecha, cliente y seleccionar por lo menos un articulo antes de guardar en la base de datos", vbCritical, "AVISO"
Exit Sub
End If
Set a = Sheets("DbFac")
uf = a.Range("A" & Rows.Count).End(xlUp).Row + 1
For x = 0 To UserForm2.ListBox1.ListCount - 1
a.Cells(uf, "A") = Val(UserForm2.Label2.Caption)
a.Cells(uf, "B") = UserForm2.TextBox3
a.Cells(uf, "C") = UserForm2.Label3.Caption
a.Cells(uf, "D") = UserForm2.TextBox1
a.Cells(uf, "E") = UserForm2.TextBox2
a.Cells(uf, "F") = UserForm2.ListBox1.List(x, 0)
a.Cells(uf, "G") = UserForm2.ListBox1.List(x, 1)
a.Cells(uf, "H") = UserForm2.ListBox1.List(x, 2)
a.Cells(uf, "I") = CDec(UserForm2.ListBox1.List(x, 3))
a.Cells(uf, "J") = CDec(ListBox1.List(x, 5))
uf = uf + 1
Next x
Set b = Sheets("Factura")
b.Range("A9:I24").ClearContents
b.Range("H2") = UserForm2.Label2
b.Range("H3") = UserForm2.TextBox3
b.Range("B6") = UserForm2.TextBox1
b.Range("G6") = UserForm2.TextBox2
fila = 9
For x = 0 To UserForm2.ListBox1.ListCount - 1
b.Cells(fila, "A") = UserForm2.ListBox1.List(x, 0)
b.Cells(fila, "B") = UserForm2.ListBox1.List(x, 1)
b.Cells(fila, "E") = UserForm2.ListBox1.List(x, 2)
b.Cells(fila, "F") = CDec(UserForm2.ListBox1.List(x, 3))
b.Cells(fila, "G") = CDec(ListBox1.List(x, 4))
b.Cells(fila, "H") = b.Cells(fila, "F") * 0.16
b.Cells(fila, "I") = (b.Cells(fila, "F") * b.Cells(fila, "G")) * 1.16
fila = fila + 1
Next x
UserForm2.TextBox1 = Clear
UserForm2.TextBox2 = Clear
UserForm2.TextBox3 = Clear
UserForm2.ListBox1.Clear
uf = Sheets("DbFac").Range("A" & Rows.Count).End(xlUp).Row
Nfac = Application.WorksheetFunction.Max(Sheets("DbFac").Range("A2" & ":A" & uf + 1)) + 1
Label2.Caption = Format(Nfac, "00000000")
Application.PrintCommunication = True
Sheets("Factura").Activate
Sheets("Factura").Range("E60,G60,I60").NumberFormat = "#,##0.00 ""U$S"""
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$I$60"
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True
ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
a.Activate
MsgBox "El comprobante de venta se guardo e imprimió con éxito", vbCritical, "AVISO"
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton6_Click()
Unload UserForm2
End Sub
Private Sub Label4_Click()
ActiveWorkbook.FollowHyperlink "http://www.programarexcel.com/p/home.html"
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
respuesta = MsgBox("¿Seguro desea eliminar el dato seleccionado?", vbCritical + vbYesNo)
If respuesta = 6 Then
fila = ListBox1.ListIndex
UserForm2.ListBox1.RemoveItem ListBox1.ListIndex
End If
For x = 0 To UserForm2.ListBox1.ListCount - 1
t = CDec(UserForm2.ListBox1.List(x, 6))
tot = tot + t
t = 0
Next x
UserForm2.Label16.Caption = "Total " & Format(tot, "#,##0.00;-#.##0,00")
UserForm2.Label14.Caption = "Subtotal " & Format((tot / 1.16), "#,##0.00;-#.##0,00")
UserForm2.Label15.Caption = "IVA " & Format(((tot / 1.16) * 0.16), "#,##0.00;-#.##0,00")
End Sub
Private Sub ListBox2_Click()
On Error Resume Next
ctr = 1
TextBox1 = Empty
TextBox2 = Empty
fila = Me.ListBox2.ListIndex
Me.TextBox1 = ListBox2.List(fila, 2)
Me.TextBox2 = ListBox2.List(fila, 3)
ListBox2.Visible = False
ctr = 0
End Sub
Private Sub TextBox1_AfterUpdate()
creg = ListBox2.ListCount
If creg = 0 Then
ListBox2.Visible = False
RESP = MsgBox("Presione SI para cargar cliente o NO para cancelar y proseguir la realización del comprobante de venta", vbYesNo, "REQUIERE CARGAR EL CLIENTE NUEVO")
If RESP = 6 Then
uf = Sheets("Clientes").Range("A" & Rows.Count).End(xlUp).Row
UserForm4.TextBox1 = Application.WorksheetFunction.Max(Sheets("Clientes").Range("A2" & ":A" & uf + 1)) + 1
UserForm4.TextBox3 = UserForm2.TextBox1
UserForm4.TextBox2.SetFocus
UserForm4.Show
Else
UserForm2.TextBox2.Locked = False
UserForm2.TextBox2 = Empty
UserForm2.TextBox2.SetFocus
End If
End If
End Sub
Private Sub TextBox1_Change()
If ctr = 1 Then Exit Sub
On Error Resume Next
Set b = Sheets("Clientes")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
Me.ListBox2.RowSource = "Clientes!A2:D" & uf
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox2.Clear
Me.ListBox2.RowSource = Clear
Me.ListBox2.ColumnCount = 4
For i = 2 To uf
strg = b.Cells(i, 3).Value
If UCase(strg) Like "*" & UCase(TextBox1.Value) & "*" Then
Me.ListBox2.AddItem b.Cells(i, 1)
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 3) = b.Cells(i, 4)
End If
Next i
Me.ListBox2.ColumnWidths = "15 pt;50 pt;80 pt;80"
ListBox2.Visible = True
End Sub
Private Sub UserForm_Initialize()
uf = Sheets("DbFac").Range("A" & Rows.Count).End(xlUp).Row
Nfac = Application.WorksheetFunction.Max(Sheets("DbFac").Range("A2" & ":A" & uf + 1)) + 1
Label2.Caption = Format(Nfac, "00000000")
Me.ListBox1.ColumnCount = 7
Me.ListBox1.ColumnWidths = "70 pt;160 pt;60 pt;60 pt;60 pt;60 pt;60 pt"
TextBox3.SetFocus
End Sub
Código que se inserta en un formulario
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
Dim t As Variant, tot As Variant
If UserForm3.TextBox1 = Empty Or UserForm3.TextBox1 = 0 Then Exit Sub
If UserForm2.ListBox1.ListCount > 50 Then
MsgBox ("No puede ingresar más de 16 articulos por factura"), vbCritical, "AVISO"
Exit Sub
End If
If KeyCode = 13 Then
can = Val(UserForm3.TextBox1)
UserForm2.ListBox1.AddItem cod
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount - 1, 1) = art
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount - 1, 2) = mar
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount - 1, 3) = Format(pv, "#,##0.0000;-#.##0,0000")
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount - 1, 4) = Format(can, "#,##0.00;-#.##0,00")
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount - 1, 5) = Format((pv * 0.16), "#,##0.00;-#.##0,00")
UserForm2.ListBox1.List(UserForm2.ListBox1.ListCount - 1, 6) = Format(((can * pv) * 1.16), "#,##0.00;-#.##0,00")
Unload UserForm3
For x = 0 To UserForm2.ListBox1.ListCount - 1
t = CDec(UserForm2.ListBox1.List(x, 6))
tot = tot + t
t = 0
Next x
UserForm2.Label16.Caption = "Total " & Format(tot, "#,##0.00 ""U$S""")
UserForm2.Label14.Caption = "Subtotal " & Format((tot / 1.16), "#,##0.00 ""U$S""")
UserForm2.Label15.Caption = "IVA " & Format(((tot / 1.16) * 0.16), "#,##0.00 ""U$S""")
End If
End Sub
Código que se inserta en un formulario
Private Sub CommandButton1_Click()
If UserForm4.TextBox1 = Empty Or UserForm4.TextBox2 = Empty Or UserForm4.TextBox3 = Empty Or UserForm4.TextBox4 = Empty Then Exit Sub
Set a = Sheets("Clientes")
uf = a.Range("A" & Rows.Count).End(xlUp).Row + 1
a.Cells(uf, "A") = Val(UserForm4.TextBox1)
a.Cells(uf, "B") = UserForm4.TextBox2
a.Cells(uf, "C") = UserForm4.TextBox3
a.Cells(uf, "D") = UserForm4.TextBox4
UserForm2.TextBox1 = UserForm4.TextBox3
UserForm2.TextBox2 = UserForm4.TextBox4
MsgBox ("Los datos se gaurdarón con éxito"), vbInformation, "AVISO"
Unload UserForm4
End Sub
Private Sub CommandButton2_Click()
Unload UserForm4
End Sub