Colocar cuadro combinado en formulario y generar recibo en pdf
Hola DANTE, tengo una consulta, como hago para agregar un cuadro combinado que me indique el mes ya que tengo varios archivos de sueldos en único lugar, o sea las nombré así: 01 Salarios, 02 Salarios, 03 Salarios, 04 Salarios, 05 Salarios, 06 salarios, 07 salarios, 08 salarios y por ejemplo si quiero consultar e imprimir el recibo de marzo, pongo arriba el mes "marzo" el código de empleado y que me genere vista previa, además de agregarle un botoncito para generar en PDF, y también es necesario que esté abierto el archivo de salarios para imprimir los recibos, ya que el archivo recibos prueba no funciona o no captura los datos si es que está cerrado si existiría la posibilidad de que aunque esté cerrado el archivo de sueldos, pueda generar recibo por mes. Saludos
1 respuesta
Te envié el archivo con el combo del mes para que hagas tus pruebas.
Este es el código resultante:
Dim l1, h1, l2, h2
Private Sub ComboBox1_Change()
'Por.DAM
If ComboBox1 = "" Then Exit Sub
If valida_archivo(False) Then
TextBox1 = ""
Else
MsgBox "El archivo no existe", vbCritical
ComboBox1.SetFocus
End If
End Sub
Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub
Private Sub CommandButton1_Click()
'Por.Dante Amor
If ComboBox1 = "" Then
MsgBox "Ingresa el Mes", vbExclamation
ComboBox1.SetFocus
Exit Sub
End If
If TextBox1 = "" Then
MsgBox "Ingresa el código", vbExclamation
TextBox1.SetFocus
Exit Sub
End If
If valida_archivo(True) Then
Set b = h2.Columns("B").Find(Val(TextBox2))
If Not b Is Nothing Then
h1.[G13] = TextBox3
h1.[C13] = h2.Cells(b.Row, "R")
h1.[E7] = CONVERTIRNUM(h2.Cells(b.Row, "R"), False)
End If
l2.Close False
UserForm2.Hide
h1.PrintPreview
UserForm2.Show
Application.ScreenUpdating = True
Else
MsgBox "El archivo no existe", vbCritical
TextBox2.SetFocus
End If
End Sub
Private Sub CommandButton2_Click()
'Limpiar
ComboBox1 = ""
TextBox1 = ""
TextBox3 = ""
TextBox4 = ""
End Sub
Private Sub CommandButton4_Click()
'Por.DAM
If ComboBox1 = "" Then
MsgBox "Ingresa el Mes", vbExclamation
ComboBox1.SetFocus
Exit Sub
End If
If TextBox1 = "" Then
MsgBox "Ingresa el código", vbExclamation
TextBox1.SetFocus
Exit Sub
End If
If valida_archivo(True) Then
Set b = h2.Columns("B").Find(Val(TextBox2))
If Not b Is Nothing Then
TextBox3 = h2.Cells(b.Row, "C")
TextBox4 = h2.Cells(b.Row, "A")
End If
l2.Close False
Else
MsgBox "El archivo no existe", vbCritical
TextBox2.SetFocus
End If
End Sub
Private Sub UserForm_Activate()
'Por.Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("ADMINISTRACION")
For i = 1 To 12
ComboBox1.AddItem Format(i, "00")
Next
ComboBox1.SetFocus
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Function valida_archivo(a As Boolean)
'Por.Dante Amor
Application.ScreenUpdating = False
ruta = l1.Path
arch = l1.Path & "\" & ComboBox1 & " SALARIOS"
dira = Dir(arch & "*.xls*")
If dira = "" Then
valida_archivo = False
Exit Function
End If
Application.ScreenUpdating = False
If a Then
Set l2 = Workbooks.Open(arch)
Set h2 = l2.Sheets(ComboBox1 & " Central Salarios")
End If
valida_archivo = True
End FunctionSaludos.Dante Amor
