Como cargar en combobox ActiveX cabeceras o header de columnas

La macro que se muestra en este post permite cargar las cabeceras o header de las columnas a un listbox ActiveX o incrustado en Excel, quizás te interese otro ejemplo con combobox incrustado en Excel en ese caso sigue el link


Antes de seguir recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

Como siempre desde el final del post se podrá descargar el ejemplo denominado Como cargar en combobox activeX cabeceras o header de columnas, en el archivo se podrá observar que al cargarse se ve un combobox incrustado en la hoja de Excel haciendo click en el mismo se observa que tiene cargadas todas las cabeceras de las columnas A1:I1.

En este ejemplo se ve como se puede recorrer las celdas de un rango con For Each, lo cual permite recorrer las celdas del rango A1 a I1 e ir cargando en el combobox los datos, de esta manera obtenemos como resultado, los datos de las cabeceras o header de las columnas cargadas en el combobox.

For Each celda In Sheets("Hoja1").Range("A1:I1")

El vídeo que sigue muestra una explicación más detallada y gráfica de la macro presentada, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo formulario que crea un listado de todas las hojas para poder luego seleccionarlas, buscar en listbox mientras escribes en textbox, ordenar hojas libro excel por su nombre, conectar Excel con Access y muchos ejemplos más.

Código que se inserta en un ThisWorkbook

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim celda
On Error Resume Next
Sheets("Hoja1").ComboBox1.Clear
For Each celda In Sheets("Hoja1").Range("A1:I1")
Sheets("Hoja1").ComboBox1.AddItem celda
Next celda
Application.ScreenUpdating = False
End Sub

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.

If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Como crear una factura o sale invoice guardar e imprimir

Es muy posible que luego de crear una factura, comprobante de venta o Sale Inovoice con Excel, sea necesario imprimir el comprobante aparte de guardarlo en la base de datos, este post resuelve este interrogante, es decir como guardar e imprimir una factura de venta o sale invoice hecha en Excel.

En esta sexta entrega de ocho y probablemente se incorpore una más donde se vincule con el stock de mercadería reduciendo el mismo a medida que se vende, en este post se mostrará como guardar e imprimir la factura o sale invoice realizada; es decir como pasar  los datos de los textbox y listbox a una hoja de Excel o base de datos.

Se ha incrementado con cada una de estas entregas la funcionalidad de la factura, en un primer momento se vio como al ingresar un cliente salía un listbox con los clientes registrados en la base de datos, seleccionando el mismo se trasladaban los datos a los textbox, luego se incorporó la opción de dar de alta un cliente cuando no fuera encontrado en la base de datos; seguidamente como elegir productos mediante un listbox y pasarlo con enter al listbox del formulario donde se está realizando la factura; seguidamente como eliminar con doble click elementos del listbox, útil cuando nos hayamos equivocado y se facture un producto por error; seguidamente como guardar la factura generada en la base de datos y automáricamente generar el número siguiente de factura.

Recuerden que lo descripto en el párrafo anterior se puede acceder desde:

Como crear una factura o sale invoice seleccionando cliente de listbox
Como crear una factura o sale invoice guardar cliente nuevo
Como crear una factura o sale invoice seleccionando articulos en listbox
Como crear una factura o sale invoice eliminar articulos del listbox
Como crear una factura o sale invoice y guardar registro
Como crear una factura o sale invoice guardar e imprimir
Como crear una factura o sale invoice y guardar en PDF
Como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por MAIL
Como crear una factura o sale invoice y descontar de Stock o Inventario

Antes de seguir recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

Recomiendo descargar el ejemplo para una mayor comprensión, una vez descargado se encuentra un botón en la hoja de Excel que permite mostrar el formulario con la Factura de Venta o Sale Invoice, el mismo contiene todo lo enseñado en los post anteriores, no obstante ello nos vamos a centrar en lo relativo al tema de impresión del comprobante de venta.

El proceso previo a la impresión es guardar el comprobante de venta esto ya lo hemos vistos en la entrega anterior de este material denominado, como crear una factura o sale invoice save and print, en este ejemplo se apela a comandos como:

Permite cortar la comunicación con la impresora para acelerar proceso de configuración.
Application.PrintCommunication = False


Activar una hoja y dar formato de moneda a un rango.
Sheets("Factura").Activate
Sheets("Factura").Range("E60,G60,I60").NumberFormat = "#,##0.00 ""U$S"""

Configurar un área de impresión
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$I$60"

Configurar la cantidad de páginas de alto y de ancho
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True

Imprimir, es decir el comando propiamente dicho para que imprima
ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

Una explicación más detallada y gráfica de la macro presentada se muestra en el vídeo que se muestra seguidamente, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como por ejemplo Como determinar el maximo valor de una columna, buscar en listbox mientras escribes en textbox, Como conectar Excel con Word crear archivo e insertar texto, Como crear un autonumerico en Excel y muchos ejemplos más.

Código que se inserta en un módulo

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

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.

If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends