• Author / Uploaded
• Daniel Guerrero Cárdenas

Citation preview

CATALOGO CUENTAS Option Explicit Private Sub btn_Agregar_Click() Dim Fila As Long Dim Final As Long Application.ScreenUpdating = False If ControlesVacios("plan_contable", Me) = True Then Exit Sub Final = nReg(Hoja2, 2, 1) With Hoja2 For Fila = 2 To Final If .Cells(Fila, 1) = Val(Me.cbo_CodCuenta) Then MsgBox ("Código de Cuenta ya existe!" + Chr(13) + "Ingrese uno diferente"), vbInformation Me.cbo_CodCuenta.SetFocus Me.cbo_CodCuenta.BackColor = RGB(211, 255, 211) Exit Sub End If Next .Unprotect "hola22" If Len(Me.cbo_CodCuenta) = 1 Or Len(Me.cbo_CodCuenta) = 2 Then .Range(.Cells(Final, 1), .Cells(Final, 3)).Font.Bold = True ElseIf Len(Me.cbo_CodCuenta) = 3 Then .Range(.Cells(Final, 1), .Cells(Final, 3)).Interior.Color = RGB(190, 190, 190) .Range(.Cells(Final, 1), .Cells(Final, 3)).Font.Color = RGB(255, 255, 255) .Range(.Cells(Final, 1), .Cells(Final, 3)).Font.Bold = True End If .Cells(Final, 1) = Me.cbo_CodCuenta.Value .Cells(Final, 2) = Me.txt_NombreCuenta.Text .Cells(Final, 3) = nGrupo Call IndexarCodCuentasPLAN .Protect "hola22" End With Me.cbo_CodCuenta = Me.cbo_CodCuenta + 1 Me.txt_NombreCuenta = Empty Me.txt_NombreCuenta.SetFocus Application.ScreenUpdating = True End Sub Private Sub btn_Eliminar_Click() Dim Fila As Long Dim Final As Long Application.ScreenUpdating = False Final = nReg(Hoja2, 2, 1) - 1 If Me.cbo_CodCuenta = Empty Then MsgBox "Seleccione un registro para eliminar", vbInformation Me.cbo_CodCuenta.BackColor = RGB(211, 255, 211) Me.cbo_CodCuenta.SetFocus Exit Sub End If If Me.txt_NombreCuenta = Empty Then MsgBox "La cuenta " & Me.cbo_CodCuenta & " no existe!", vbInformation Me.cbo_CodCuenta = Empty

Me.cbo_CodCuenta.BackColor = RGB(211, 255, 211) Me.cbo_CodCuenta.SetFocus Exit Sub End If With Hoja2 For Fila = 2 To Final If .Cells(Fila, 1) = Val(Me.cbo_CodCuenta) _ And Mid(.Cells(Fila + 1, 1), 1, 1) = Val(Me.cbo_CodCuenta) Then MsgBox "Este elemento contable tiene rubros asociados y no puede ser eliminado!", vbCritical Exit Sub ElseIf .Cells(Fila, 1) = Val(Me.cbo_CodCuenta) _ And Mid(.Cells(Fila + 1, 1), 1, 2) = Val(Me.cbo_CodCuenta) Then MsgBox "Este rubro tiene cuentas de mayor asociadas y no puede ser eliminado!", vbCritical Exit Sub ElseIf .Cells(Fila, 1) = Val(Me.cbo_CodCuenta) _ And Mid(.Cells(Fila + 1, 1), 1, 3) = Val(Me.cbo_CodCuenta) Then MsgBox "Esta cuenta de mayor tiene cuentas asociadas y no puede ser eliminada!", vbCritical Exit Sub ElseIf .Cells(Fila, 1) = Val(Me.cbo_CodCuenta) _ And Mid(.Cells(Fila + 1, 1), 1, 5) = Val(Me.cbo_CodCuenta) Then MsgBox "Esta cuenta tiene subcuentas asociadas y no puede ser eliminada!", vbCritical Exit Sub End If Next If MsgBox("¿Seguro que quiere eliminar esta Cuenta?", vbQuestion + vbYesNo) = vbYes Then For Fila = 2 To Final If .Cells(Fila, 1) = Val(Me.cbo_CodCuenta) Then .Unprotect "hola22" .Cells(Fila, 1).EntireRow.Delete .Protect "hola22" Exit For End If Next MsgBox "La cuenta: " & Me.cbo_CodCuenta & " ha sido eliminada!", vbInformation Call LimpiarControles("plan_contable", Me) Me.cbo_CodCuenta.SetFocus Else Exit Sub End If End With Application.ScreenUpdating = True End Sub Private Sub btn_ListadoCuentas_Click() banderaListadoCuentas = 1 Call LanzarListadoCuentas(Me, "lbl_LanzarListadoCuentas") End Sub

Private Sub btn_Salir_Click() Unload Me End Sub Private Sub cbo_CodCuenta_Change() Dim Fila As Long Dim Final As Long Dim encontrado As Boolean Me.cbo_CodCuenta.BackColor = RGB(255, 255, 255) Call ValidarCuenta If Me.cbo_CodCuenta = Empty Then Me.txt_NombreCuenta = Empty Exit Sub End If Final = nReg(Hoja2, 2, 1) - 1 For Fila = 2 To Final If Hoja2.Cells(Fila, 1) = Val(Me.cbo_CodCuenta) Then encontrado = True Me.txt_NombreCuenta = Hoja2.Cells(Fila, 2) Exit For End If Next If encontrado = False Then Me.txt_NombreCuenta = Empty End If End Sub Private Sub cbo_CodCuenta_Enter() Dim Fila As Long Dim Final As Long Dim Lista As Long Do While Me.cbo_CodCuenta.ListCount > 0 Me.cbo_CodCuenta.RemoveItem 0 Loop Final = nReg(Hoja2, 2, 1) - 1 For Fila = 2 To Final Lista = Hoja2.Cells(Fila, 1) Me.cbo_CodCuenta.AddItem Lista Next End Sub Private Sub cbo_CodCuenta_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End If End Sub Private Sub txt_NombreCuenta_Change() Me.txt_NombreCuenta.BackColor = RGB(255, 255, 255) Me.txt_NombreCuenta = UCase(Me.txt_NombreCuenta) End Sub

LIBRO DIARIO Option Explicit Dim i As Long 'Representa los items en el ListBox de este formulario Private Sub btn_Editar_Click() With Me.lbx_DebeHaber If .ListIndex = -1 Then MsgBox "Seleccione un registro para editar", vbInformation Exit Sub End If If Me.btn_Editar.Caption = "Editar" Then If MsgBox("¿Seguro que quiere modificar esta operación?", vbQuestion + vbYesNo) = vbYes Then .Locked = True Call OcultarBotonesRestantes Me.cbo_CodCuenta.Value = .List(.ListIndex, 0) Me.txt_Concepto.Text = .List(.ListIndex, 4) If Me.opt_Cargar.Value = True Then Me.txt_Monto.Value = .List(.ListIndex, 2) Else Me.txt_Monto.Value = .List(.ListIndex, 3) End If Me.btn_Editar.Caption = "Guardar cambios" Exit Sub Else .ListIndex = -1 Exit Sub End If End If If Me.btn_Editar.Caption = "Guardar cambios" Then .Locked = False .List(.ListIndex, 0) = Me.cbo_CodCuenta.Value .List(.ListIndex, 1) = Me.txt_NombreCuenta.Text .List(.ListIndex, 4) = Me.txt_Concepto.Text If Me.opt_Cargar.Value = True Then .List(.ListIndex, 2) = Me.txt_Monto.Value Call sumarDebe Else .List(.ListIndex, 3) = Me.txt_Monto.Value Call sumarhaber End If Call LimpiarControles("libro_diario", Me) MsgBox "Cambios guardados satisfactoriamente!", vbInformation Me.btn_Editar.Caption = "Editar" Call MostrarBotonesRestantes End If End With End Sub

Private Sub btn_Eliminar_Click() With Me.lbx_DebeHaber If .ListIndex = -1 Then MsgBox "Seleccione un registro para eliminar", vbInformation Exit Sub End If If MsgBox("¿Seguro que quiere eliminar esta operación?", vbQuestion + vbYesNo) = vbYes Then If Me.opt_Cargar.Value = True Then .RemoveItem (.ListIndex) .ListIndex = -1 Call sumarDebe Else .RemoveItem (.ListIndex) .ListIndex = -1 Call sumarhaber End If i=i-1 MsgBox "La operación ha sido eliminada!", vbInformation Else .ListIndex = -1 Exit Sub End If If .ListCount = Empty Then Call OcultarBotonesEditarEliminar End If End With End Sub Private Sub btn_LimpiarItems_Click() Call LimpiarControles("libro_diario", Me) Call LimpiarItems Call OcultarBotonesEditarEliminar End Sub Private Sub btn_Registrar_Click() If Me.btn_Editar.Caption = "Guardar cambios" Then MsgBox "Debe guardar los cambios realizados", vbInformation Exit Sub End If If ControlesVacios("libro_diario", Me, Frame1, True) = True Then Exit Sub If Me.chk_ISR.Value = True Then Call CalcularRetencionISR End If If Me.chk_IVA.Value = True Then Call CalcularIVA End If With Me 'Busca un item en el ListBox, que si está repetido, no permite agregarlo nuevamente 'obligando al usuario a seleccionar uno diferente For i = 0 To .lbx_DebeHaber.ListCount - 1 If .lbx_DebeHaber.List(i, 0) = .cbo_CodCuenta Then MsgBox "Esta cuenta ya se agregó, elija una diferente" .lbx_DebeHaber.ListIndex = i Exit Sub End If Next

.lbx_DebeHaber.AddItem .cbo_CodCuenta.Value .lbx_DebeHaber.List(i, 1) = .txt_NombreCuenta.Text If .opt_Cargar.Value = True Then .lbx_DebeHaber.List(i, 2) = .txt_Monto.Value Call sumarDebe Else .lbx_DebeHaber.List(i, 3) = .txt_Monto.Value Call sumarhaber End If .lbx_DebeHaber.List(i, 4) = .txt_Concepto.Text i=i+1 .lbx_DebeHaber.ListIndex = -1 'Elimina la selección del ListBox End With Call LimpiarControles("libro_diario", Me) Call MostrarBotonesEditarEliminar Me.chk_ISR.Value = False Me.chk_IVA.Value = False End Sub Private Sub btn_ListadoCuentas_Click() banderaListadoCuentas = 2 Call LanzarListadoCuentas(Me, "lbl_LanzarListadoCuentas") End Sub Private Sub btn_EnviarADiario_Click() Dim Final As Long On Error Resume Next If Me.lbx_DebeHaber.ListCount = Empty Then MsgBox "No hay movimientos para procesar", vbInformation Exit Sub End If If Me.lbl_Diferencia.Caption 0 Then MsgBox "La partida aún no está cuadrada!", vbCritical Exit Sub End If Final = nReg(Hoja3, 2, 3) With Hoja3 If MsgBox("¿Seguro que desea continuar?", vbQuestion + vbYesNo) = vbYes Then Application.ScreenUpdating = False .Range("C" & Final).Offset(0, -1) = CDate(Me.txt_Fecha) ' Fecha .Range("C" & Final).Offset(0, -2) = Me.txt_Asiento.Value ' Partida For i = 0 To Me.lbx_DebeHaber.ListCount - 1 .Cells(Final, 3) = Me.lbx_DebeHaber.List(i, 4) ' Concepto .Cells(Final, 4) = Me.lbx_DebeHaber.List(i, 0) ' Cuenta .Cells(Final, 5) = Me.lbx_DebeHaber.List(i, 1) ' Nombre de Cuenta ' DEBE Me.lbx_DebeHaber.List(i, 2) = _ Replace(Me.lbx_DebeHaber.List(i, 2), Application.ThousandsSeparator, "") ' Elimino el separador de miles Me.lbx_DebeHaber.List(i, 2) = _ Replace(Me.lbx_DebeHaber.List(i, 2), Application.DecimalSeparator, ".") 'sustituyo el separador decimal

.Cells(Final, 6) = Me.lbx_DebeHaber.List(i, 2) ' Debe .Cells(Final, 6).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" ' HABER Me.lbx_DebeHaber.List(i, 3) = _ Replace(Me.lbx_DebeHaber.List(i, 3), Application.ThousandsSeparator, "") 'elimino el separador de miles Me.lbx_DebeHaber.List(i, 3) = _ Replace(Me.lbx_DebeHaber.List(i, 3), Application.DecimalSeparator, ".") 'Sustituyo el separador decimal .Cells(Final, 7) = Me.lbx_DebeHaber.List(i, 3) ' Haber .Cells(Final, 7).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" Final = Final + 1 Next .Range(.Range("C" & Final - 1).Offset(0, -2), _ .Range("C" & Final - 1).Offset(0, 4)).Borders(xlEdgeBottom).Weight = xlHairline Application.ScreenUpdating = True Else Exit Sub End If End With Call LimpiarItems Call CorrelativoPartidas Call OcultarBotonesEditarEliminar End Sub Private Sub btn_Salir_Click() Unload Me End Sub Private Sub cbo_CodCuenta_Change() Dim Fila As Long Dim Final As Long Dim encontrado As Boolean Me.cbo_CodCuenta.BackColor = RGB(255, 255, 255) If Me.cbo_CodCuenta = Empty Then Me.txt_NombreCuenta = Empty Exit Sub End If Final = nReg(Hoja2, 2, 1) - 1 For Fila = 2 To Final If Hoja2.Cells(Fila, 1) = Val(Me.cbo_CodCuenta) Then encontrado = True Me.txt_NombreCuenta = Hoja2.Cells(Fila, 2) Exit For End If Next If encontrado = False Then Me.txt_NombreCuenta = Empty End If End Sub

Private Sub cbo_CodCuenta_Enter() Dim Fila As Long Dim Final As Long Dim Lista As Long Do While Me.cbo_CodCuenta.ListCount > 0 Me.cbo_CodCuenta.RemoveItem 0 Loop Final = nReg(Hoja2, 2, 1) - 1 For Fila = 2 To Final Lista = Hoja2.Cells(Fila, 1) Me.cbo_CodCuenta.AddItem Lista Next End Sub Private Sub cbo_CodCuenta_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End If End Sub Private Sub chk_ISR_Click() If Me.chk_ISR.Value = True Then Me.chk_IVA.Value = False End If End Sub Private Sub chk_IVA_Click() If Me.chk_IVA.Value = True Then Me.chk_ISR.Value = False End If End Sub Private Sub lbx_DebeHaber_Click() On Error GoTo optAbonar If Me.lbx_DebeHaber.List(Me.lbx_DebeHaber.ListIndex, 2) Then Me.opt_Cargar = True Else optAbonar: Me.opt_Abonar = True End If End Sub Private Sub opt_Abonar_Change() Me.chk_ISR.Value = False Me.chk_ISR.Visible = False End Sub Private Sub opt_Cargar_Change() Me.chk_ISR.Value = False Me.chk_ISR.Visible = True End Sub Private Sub txt_Concepto_Change() Me.txt_Concepto.BackColor = RGB(255, 255, 255) Me.txt_Concepto = UCase(Me.txt_Concepto) End Sub

Private Sub btn_LanzarCalendario_Click() banderaCalendario = 1 Call LanzarCalendario(Me, "txt_Fecha") End Sub Private Sub txt_Monto_Change() Me.txt_Monto.BackColor = RGB(255, 255, 255) End Sub Private Sub txt_Monto_Exit(ByVal Cancel As MSForms.ReturnBoolean) On Error Resume Next Me.txt_Monto = FormatNumber(Me.txt_Monto, 2) End Sub Private Sub txt_Monto_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If Application.DecimalSeparator = "." Then If KeyAscii 46 And KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End If Else If KeyAscii 44 And KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End If End If End Sub Private Sub txt_NombreCuenta_Change() Me.txt_NombreCuenta.BackColor = RGB(255, 255, 255) End Sub Private Sub UserForm_Activate() Me.txt_Fecha.Text = Date Me.cbo_CodCuenta.SetFocus End Sub Private Sub UserForm_Initialize() Call OcultarBotonesEditarEliminar Call CorrelativoPartidas Me.lbx_DebeHaber.ColumnCount = 5 Me.lbx_DebeHaber.ColumnWidths = "45 pt;160 pt;75 pt;75 pt;0 pt" End Sub Private Sub LimpiarItems() Me.lbx_DebeHaber.Clear i=0 Me.cbo_CodCuenta.BackColor = RGB(255, 255, 255) Me.txt_NombreCuenta.BackColor = RGB(255, 255, 255) Me.txt_Monto.BackColor = RGB(255, 255, 255) Me.txt_Concepto.BackColor = RGB(255, 255, 255) Me.lbl_SumaDebe.Caption = "0.00" Me.lbl_SumaHaber.Caption = "0.00" Me.lbl_Diferencia.Caption = "0.00" Me.lbl_Diferencia.ForeColor = RGB(255, 255, 255) Me.opt_Cargar.Value = True Me.chk_IVA.Value = False Me.chk_ISR.Value = False End Sub

Private Sub CorrelativoPartidas() Dim Final As Long Final = nReg(Hoja3, 2, 3) - 1 If Hoja3.Cells(Final, 1) = "Partida No." Then Me.txt_Asiento.Value = 1 Else Me.txt_Asiento.Value = Hoja3.Range("C" & Final).Offset(0, -2).End(xlUp) + 1 End If End Sub Private Sub CalcularRetencionISR() Dim nCodigoCta As Long Dim sNombreCta As String Dim sConcepto As String Dim valorISR As Currency valorISR = 0 With Me.lbx_DebeHaber valorISR = (Me.txt_Monto.Value / 100) * 10 If Me.opt_Cargar.Value = True Then nCodigoCta = 1160202 sNombreCta = "RETENCIÓN ISR 10%" sConcepto = "IMPUESTO SOBRE LA RENTA RETENIDO SEGÚN ARTÍCULO 156" .AddItem nCodigoCta .List(i, 1) = sNombreCta .List(i, 2) = FormatNumber(-valorISR, 2) .List(i, 4) = sConcepto End If i=i+1 End With End Sub Private Sub CalcularIVA() Dim nCodigoCta1 As Long Dim nCodigoCta2 As Long Dim sNombreCta1 As String Dim sNombreCta2 As String Dim sConcepto1 As String Dim sConcepto2 As String Dim valorIVA As Currency valorIVA = 0 With Me.lbx_DebeHaber valorIVA = (Me.txt_Monto.Value / 100) * 13 If Me.opt_Cargar.Value = True Then nCodigoCta1 = 1170101 sNombreCta1 = "IVA CRÉDITO FISCAL 13%" sConcepto1 = "CRÉDITO FISCAL" .AddItem nCodigoCta1 .List(i, 1) = sNombreCta1 .List(i, 2) = FormatNumber(valorIVA, 2) .List(i, 4) = sConcepto1

Else nCodigoCta2 = 20201 sNombreCta2 = "IVA DÉBITO FISCAL 13%" sConcepto2 = "DÉBITO FISCAL" .AddItem nCodigoCta2 .List(i, 1) = sNombreCta2 .List(i, 3) = FormatNumber(valorIVA, 2) .List(i, 4) = sConcepto2 .List(i, 4) = sConcepto2 End If i=i+1 End With End Sub Private Sub OcultarBotonesEditarEliminar() Me.btn_Editar.Visible = False Me.btn_Eliminar.Visible = False End Sub Private Sub MostrarBotonesEditarEliminar() Me.btn_Editar.Visible = True Me.btn_Eliminar.Visible = True End Sub Private Sub OcultarBotonesRestantes() Me.btn_Eliminar.Visible = False Me.btn_Registrar.Visible = False Me.btn_EnviarADiario.Visible = False Me.btn_LimpiarItems.Visible = False Me.chk_ISR.Visible = False Me.chk_IVA.Visible = False End Sub Private Sub MostrarBotonesRestantes() Me.btn_Eliminar.Visible = True Me.btn_Registrar.Visible = True Me.btn_EnviarADiario.Visible = True Me.btn_LimpiarItems.Visible = True If Me.opt_Cargar.Value = True Then Me.chk_ISR.Visible = True End If Me.chk_IVA.Visible = True End Sub

LISTADO DE CUENTAS Option Explicit Private Sub btn_InsertarItem_Click() Call InsertarCuentadesdeListBox End Sub Private Sub btn_Salir_Click() Unload Me End Sub Private Sub lbx_Cuentas_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Call InsertarCuentadesdeListBox End Sub Private Sub UserForm_Activate() Dim Fila As Long Dim Final As Long Final = nReg(Hoja2, 2, 1) - 1 With frm_ListadoCuentas For Fila = 2 To Final .lbx_Cuentas.AddItem Hoja2.Cells(Fila, 1) .lbx_Cuentas.List(.lbx_Cuentas.ListCount - 1, 1) = Hoja2.Cells(Fila, 2) Next End With Call BuscarItemEnListBox End Sub Private Sub UserForm_Initialize() Call CambiarTamanoListboxCuentas Me.lbx_Cuentas.ColumnCount = 2 Me.lbx_Cuentas.ColumnWidths = "45 pt;150 pt" End Sub FILTRAR RANGOS DE FECHAS Option Explicit Private Sub CommandButton1_Click() banderaCalendario = 2 Call LanzarCalendario(Me, "TextBox1") End Sub Private Sub CommandButton2_Click() banderaCalendario = 3 Call LanzarCalendario(Me, "TextBox2") End Sub

CALENDARIO Option Explicit Private Sub cboMes_Click() ModuloCalendario.CambioDeMes End Sub Private Sub lbl1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl1.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl1.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl1 As Control Set Control_lbl1 = frmCalendario.lbl1 Call ModuloCalendario.MarcarDia(Control_lbl1) End Sub Private Sub lbl10_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl10.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl10.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl10_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl10 As Control Set Control_lbl10 = frmCalendario.lbl10 Call ModuloCalendario.MarcarDia(Control_lbl10) End Sub Private Sub lbl11_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl11.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl11.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub

Private Sub lbl11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl11 As Control Set Control_lbl11 = frmCalendario.lbl11 Call ModuloCalendario.MarcarDia(Control_lbl11) End Sub Private Sub lbl12_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl12.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl12.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl12 As Control Set Control_lbl12 = frmCalendario.lbl12 Call ModuloCalendario.MarcarDia(Control_lbl12) End Sub Private Sub lbl13_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl13.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl13.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl13_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl13 As Control Set Control_lbl13 = frmCalendario.lbl13 Call ModuloCalendario.MarcarDia(Control_lbl13) End Sub Private Sub lbl14_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl14.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl14.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl14_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl14 As Control Set Control_lbl14 = frmCalendario.lbl14 Call ModuloCalendario.MarcarDia(Control_lbl14) End Sub

Private Sub lbl15_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl15.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl15.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl15_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl15 As Control Set Control_lbl15 = frmCalendario.lbl15 Call ModuloCalendario.MarcarDia(Control_lbl15) End Sub Private Sub lbl16_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl16.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl16.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl16_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl16 As Control Set Control_lbl16 = frmCalendario.lbl16 Call ModuloCalendario.MarcarDia(Control_lbl16) End Sub Private Sub lbl17_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl17.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl17.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub

Private Sub lbl17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl17 As Control Set Control_lbl17 = frmCalendario.lbl17 Call ModuloCalendario.MarcarDia(Control_lbl17) End Sub Private Sub lbl18_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl18.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl18.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl18_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl18 As Control Set Control_lbl18 = frmCalendario.lbl18 Call ModuloCalendario.MarcarDia(Control_lbl18) End Sub Private Sub lbl19_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl19.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl19.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl19_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl19 As Control Set Control_lbl19 = frmCalendario.lbl19 Call ModuloCalendario.MarcarDia(Control_lbl19) End Sub Private Sub lbl2_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl2.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl2.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub

Private Sub lbl2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl2 As Control Set Control_lbl2 = frmCalendario.lbl2 Call ModuloCalendario.MarcarDia(Control_lbl2) End Sub Private Sub lbl20_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl20.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl20.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl20_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl20 As Control Set Control_lbl20 = frmCalendario.lbl20 Call ModuloCalendario.MarcarDia(Control_lbl20) End Sub Private Sub lbl21_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl21.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl21.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl21_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl21 As Control Set Control_lbl21 = frmCalendario.lbl21 Call ModuloCalendario.MarcarDia(Control_lbl21) End Sub Private Sub lbl22_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl22.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl22.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub

Private Sub lbl22_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl22 As Control Set Control_lbl22 = frmCalendario.lbl22 Call ModuloCalendario.MarcarDia(Control_lbl22) End Sub Private Sub lbl23_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl23.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl23.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl23_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl23 As Control Set Control_lbl23 = frmCalendario.lbl23 Call ModuloCalendario.MarcarDia(Control_lbl23) End Sub Private Sub lbl24_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl24.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl24.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl24_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl24 As Control Set Control_lbl24 = frmCalendario.lbl24 Call ModuloCalendario.MarcarDia(Control_lbl24) End Sub Private Sub lbl25_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl25.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl25.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub

Private Sub lbl25_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl25 As Control Set Control_lbl25 = frmCalendario.lbl25 Call ModuloCalendario.MarcarDia(Control_lbl25) End Sub Private Sub lbl26_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl26.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl26.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl26_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl26 As Control Set Control_lbl26 = frmCalendario.lbl26 Call ModuloCalendario.MarcarDia(Control_lbl26) End Sub Private Sub lbl27_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl27.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl27.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl27_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl27 As Control Set Control_lbl27 = frmCalendario.lbl27 Call ModuloCalendario.MarcarDia(Control_lbl27) End Sub Private Sub lbl28_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl28.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl28.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub

Private Sub lbl28_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl28 As Control Set Control_lbl28 = frmCalendario.lbl28 Call ModuloCalendario.MarcarDia(Control_lbl28) End Sub Private Sub lbl29_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl29.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl29.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl29_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl29 As Control Set Control_lbl29 = frmCalendario.lbl29 Call ModuloCalendario.MarcarDia(Control_lbl29) End Sub Private Sub lbl3_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl3.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl3.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl3 As Control Set Control_lbl3 = frmCalendario.lbl3 Call ModuloCalendario.MarcarDia(Control_lbl3) End Sub Private Sub lbl30_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl30.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl30.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub

Private Sub lbl30_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl30 As Control Set Control_lbl30 = frmCalendario.lbl30 Call ModuloCalendario.MarcarDia(Control_lbl30) End Sub Private Sub lbl31_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl31.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl31.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl31_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl31 As Control Set Control_lbl31 = frmCalendario.lbl31 Call ModuloCalendario.MarcarDia(Control_lbl31) End Sub Private Sub lbl32_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl32.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl32.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl32_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl32 As Control Set Control_lbl32 = frmCalendario.lbl32 Call ModuloCalendario.MarcarDia(Control_lbl32) End Sub Private Sub lbl33_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl33.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl33.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value)

Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl33_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl33 As Control Set Control_lbl33 = frmCalendario.lbl33 Call ModuloCalendario.MarcarDia(Control_lbl33) End Sub Private Sub lbl34_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl34.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl34.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl34_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl34 As Control Set Control_lbl34 = frmCalendario.lbl34 Call ModuloCalendario.MarcarDia(Control_lbl34) End Sub Private Sub lbl35_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl35.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl35.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl35_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl35 As Control Set Control_lbl35 = frmCalendario.lbl35 Call ModuloCalendario.MarcarDia(Control_lbl35) End Sub

Private Sub lbl36_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl36.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl36.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl36_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl36 As Control Set Control_lbl36 = frmCalendario.lbl36 Call ModuloCalendario.MarcarDia(Control_lbl36) End Sub Private Sub lbl37_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl37.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl37.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl37_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl37 As Control Set Control_lbl37 = frmCalendario.lbl37 Call ModuloCalendario.MarcarDia(Control_lbl37) End Sub Private Sub lbl38_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl38.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl38.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub

Private Sub lbl38_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl38 As Control Set Control_lbl38 = frmCalendario.lbl38 Call ModuloCalendario.MarcarDia(Control_lbl38) End Sub Private Sub lbl39_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl39.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl39.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl39_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl39 As Control Set Control_lbl39 = frmCalendario.lbl39 Call ModuloCalendario.MarcarDia(Control_lbl39) End Sub Private Sub lbl4_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl4.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl4.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl4 As Control Set Control_lbl4 = frmCalendario.lbl4 Call ModuloCalendario.MarcarDia(Control_lbl4) End Sub Private Sub lbl40_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl40.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl40.Caption)

Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl40_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl40 As Control Set Control_lbl40 = frmCalendario.lbl40 Call ModuloCalendario.MarcarDia(Control_lbl40) End Sub Private Sub lbl41_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl41.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl41.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl41_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl41 As Control Set Control_lbl41 = frmCalendario.lbl41 Call ModuloCalendario.MarcarDia(Control_lbl41) End Sub Private Sub lbl42_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl42.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl42.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl42_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl42 As Control Set Control_lbl42 = frmCalendario.lbl42 Call ModuloCalendario.MarcarDia(Control_lbl42) End Sub

Private Sub lbl5_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl5.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl5.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl5 As Control Set Control_lbl5 = frmCalendario.lbl5 Call ModuloCalendario.MarcarDia(Control_lbl5) End Sub Private Sub lbl6_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl6.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl6.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl6_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl6 As Control Set Control_lbl6 = frmCalendario.lbl6 Call ModuloCalendario.MarcarDia(Control_lbl6) End Sub Private Sub lbl7_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl7.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl7.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl7_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl7 As Control Set Control_lbl7 = frmCalendario.lbl7 Call ModuloCalendario.MarcarDia(Control_lbl7) End Sub Private Sub lbl8_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl8.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long

Dia = VBA.CLng(frmCalendario.lbl8.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl8_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl8 As Control Set Control_lbl8 = frmCalendario.lbl8 Call ModuloCalendario.MarcarDia(Control_lbl8) End Sub Private Sub lbl9_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If frmCalendario.lbl9.Caption "-" Then Dim Dia As Long, Mes As Long, Ano As Long Dia = VBA.CLng(frmCalendario.lbl9.Caption) Mes = VBA.CLng(frmCalendario.cboMes.Value) Ano = VBA.CLng(frmCalendario.lblAno.Caption) Unload frmCalendario Call ModuloCalendario.RecibeLaFecha(Dia, Mes, Ano) End If End Sub Private Sub lbl9_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Dim Control_lbl9 As Control Set Control_lbl9 = frmCalendario.lbl9 Call ModuloCalendario.MarcarDia(Control_lbl9) End Sub Private Sub cmdSalirConEscape_Click() Call ModuloCalendario.SalirConEscape End Sub Private Sub lblHoy_Click() ModuloCalendario.UnClickEnHoyEs End Sub Private Sub spbAño_Change() ModuloCalendario.CambioDeAno End Sub Private Sub UserForm_Initialize() Call ModuloCalendario.InicializaFormularioCalendario End Sub

FUNCIONES Option Explicit Public banderaCalendario As Long Public Function nReg(Hoja As Worksheet, nFila As Long, nColumna As Long) Do Until IsEmpty(Hoja.Cells(nFila, nColumna)) nFila = nFila + 1 Loop nReg = nFila End Function Public Function LimpiarControles(xTag As String, xForm As UserForm) Dim xCtrl As Control For Each xCtrl In xForm.Controls If xCtrl.Tag = xTag Then xCtrl = Empty End If Next End Function Public Function ControlesVacios(xTag As String, xForm As UserForm, Optional xContenedor As Object, _ Optional Switch As Boolean) As Boolean Dim xCtrl As Control If Switch = True Then For Each xCtrl In xContenedor.Controls If xCtrl.Tag = xTag And xCtrl = Empty Then ControlesVacios = True MsgBox "Debe rellenar el campo: " & UCase(xCtrl.ControlTipText), vbInformation xCtrl.SetFocus xCtrl.BackColor = RGB(211, 255, 211) Exit Function End If Next Else For Each xCtrl In xForm.Controls If xCtrl.Tag = xTag And xCtrl = Empty Then ControlesVacios = True MsgBox "Debe rellenar el campo: " & UCase(xCtrl.ControlTipText), vbInformation xCtrl.SetFocus xCtrl.BackColor = RGB(211, 255, 211) Exit Function End If Next End If End Function Public Function LanzarCalendario(CualquierFormulario As Object, xTextBox As String)

Dim xCtrl As Control Load frmCalendario For Each xCtrl In CualquierFormulario.Controls If xCtrl.Name = xTextBox Then frmCalendario.StartUpPosition = 0 frmCalendario.Left = CualquierFormulario.Left + xCtrl.Left + 5 frmCalendario.Top = CualquierFormulario.Top + xCtrl.Top + xCtrl.Height + 25 End If Next frmCalendario.Show End Function Public Function LanzarListadoCuentas(CualquierFormulario As Object, CualquierControl As String) Dim xCtrl As Control Load frm_ListadoCuentas For Each xCtrl In CualquierFormulario.Controls If xCtrl.Name = CualquierControl Then frm_ListadoCuentas.StartUpPosition = 0 frm_ListadoCuentas.Left = CualquierFormulario.Left + xCtrl.Left frm_ListadoCuentas.Top = CualquierFormulario.Top End If Next frm_ListadoCuentas.Show End Function Public Function InsertarFecha(Fecha As Date) Select Case banderaCalendario Case 1 frm_LibroDiario.txt_Fecha.Text = Fecha Case 2 UserForm1.TextBox1.Text = Fecha Case 3 UserForm1.TextBox2.Text = Fecha Case Else MsgBox "La petición solicitada, aún no se ha establecido dentro de la declaración SELECT CASE", vbCritical End Select End Function

MODULO CALENDARIO Option Explicit Option Private Module Private SenalCambioMes As Long Public Sub RecibeLaFecha(Dia As Long, Mes As Long, Ano As Long) Dim FechaRecibida As Date FechaRecibida = VBA.DateSerial((VBA.CInt(Ano)), (VBA.CInt(Mes)), (VBA.CInt(Dia))) 'DIRECCIONE LA FECHA AL CONTROL O CELDA QUE REQUIERA Call InsertarFecha(FechaRecibida) End Sub Public Sub InicializaFormularioCalendario() SenalCambioMes = 1 With frmCalendario.cboMes .AddItem 1 .List(0, 1) = "enero" .AddItem 2 .List(1, 1) = "febrero" .AddItem 3 .List(2, 1) = "marzo" .AddItem 4 .List(3, 1) = "abril" .AddItem 5 .List(4, 1) = "mayo" .AddItem 6 .List(5, 1) = "junio" .AddItem 7 .List(6, 1) = "julio" .AddItem 8 .List(7, 1) = "agosto" .AddItem 9 .List(8, 1) = "septiembre" .AddItem 10 .List(9, 1) = "octubre" .AddItem 11 .List(10, 1) = "noviembre" .AddItem 12 .List(11, 1) = "diciembre" End With frmCalendario.cboMes.ListIndex = VBA.Month(VBA.Date) - 1 frmCalendario.spbAño.Value = VBA.Year(VBA.Date) frmCalendario.lblAno.Caption = VBA.Year(VBA.Date) Dim Ano As Long, Mes As Long Ano = VBA.Year(VBA.Date) Mes = VBA.Month(VBA.Date) Call ModuloCalendario.CargarLosDias(Ano, Mes) frmCalendario.lblHoy.Caption = VBA.Date End Sub

Public Sub CargarLosDias(Ano As Long, Mes As Long) Dim FechaDelPrimerDia As Date Dim FechaDelUltimoDia As Date Dim DiaSemanaPrimerDia As Long Dim VariableControl As Control Dim Contador As Long FechaDelPrimerDia = VBA.DateSerial(Ano, Mes, 1) FechaDelUltimoDia = Application.WorksheetFunction.EoMonth(VBA.DateSerial(Ano, Mes, 1), 0) DiaSemanaPrimerDia = Application.WorksheetFunction.Weekday(FechaDelPrimerDia, 2) Contador = 1 For Each VariableControl In frmCalendario.mrcDias.Controls VariableControl.Caption = "-" If VariableControl.Tag >= DiaSemanaPrimerDia And Contador 1 Then Dim MesEnElCombo As Long, AnoEnElLabel As Long If Not (IsNull(frmCalendario.cboMes.Value)) And Not (IsNull(frmCalendario.lblAno.Caption)) Then MesEnElCombo = VBA.CLng(frmCalendario.cboMes.Value) AnoEnElLabel = VBA.CLng(frmCalendario.lblAno.Caption) Call ModuloCalendario.DesmarcarDias Call ModuloCalendario.CargarLosDias(AnoEnElLabel, MesEnElCombo) End If End If SenalCambioMes = SenalCambioMes + 1 End Sub Public Sub CambioDeAno() Dim MesEnElCombo As Long, AnoEnElLabel As Long frmCalendario.lblAno.Caption = frmCalendario.spbAño.Value MesEnElCombo = VBA.CLng(frmCalendario.cboMes.Value) AnoEnElLabel = VBA.CLng(frmCalendario.lblAno.Caption) Call ModuloCalendario.DesmarcarDias Call ModuloCalendario.CargarLosDias(AnoEnElLabel, MesEnElCombo) End Sub Public Sub UnClickEnHoyEs() Dim Mes As Long, Ano As Long Dim FechaActual As Date FechaActual = VBA.CDate(frmCalendario.lblHoy.Caption) Mes = VBA.CLng(VBA.Month(FechaActual)) Ano = VBA.CLng(VBA.Year(FechaActual)) frmCalendario.lblAno.Caption = Ano frmCalendario.cboMes.ListIndex = Mes - 1 frmCalendario.spbAño.Value = Ano frmCalendario.spbAño.SetFocus Call ModuloCalendario.DesmarcarDias Call ModuloCalendario.CargarLosDias(Ano, Mes) End Sub

Sub SalirConEscape() Unload frmCalendario End Sub Sub MarcarDia(ControlDeEtiqueta As Control) Call ModuloCalendario.DesmarcarDias ControlDeEtiqueta.Font.Bold = True ControlDeEtiqueta.ForeColor = VBA.RGB(255, 0, 0) End Sub Sub DesmarcarDias() Dim ControlEtiqueta As Control For Each ControlEtiqueta In frmCalendario.mrcDias.Controls ControlEtiqueta.Font.Bold = False ControlEtiqueta.ForeColor = VBA.RGB(0, 0, 0) Next ControlEtiqueta End Sub

PROCEDIMIENTOS Option Explicit Public banderaListadoCuentas As Long Public nGrupo As Long Sub ValidarCuenta() Dim Fila As Long Dim Final As Long Dim encontrado As Boolean With frm_CatalogoCuentas Final = nReg(Hoja1, 2, 1) - 1 For Fila = 2 To Final If Hoja1.Cells(Fila, 1) = Val(Mid(.cbo_CodCuenta, 1, 1)) _ Or .cbo_CodCuenta = Empty Then encontrado = True nGrupo = Hoja1.Cells(Fila, 1) Exit Sub End If Next If encontrado = False Then MsgBox "La cuenta: " & .cbo_CodCuenta & _ " aún no se ha establecido en los parámetros", vbInformation .cbo_CodCuenta = Empty .cbo_CodCuenta.BackColor = RGB(211, 255, 211) .cbo_CodCuenta.SetFocus Exit Sub End If End With End Sub Sub Run_CatalogoCuentas() Load frm_CatalogoCuentas frm_CatalogoCuentas.Show End Sub Sub Run_LibroDiario() Load frm_LibroDiario frm_LibroDiario.Show End Sub Sub CodCuentaATexto() Dim Celda As Object Dim miRangoDinamico As String Dim Rango As Range Dim Final As Long Final = nReg(Hoja2, 2, 1) - 1 miRangoDinamico = "A" & 2 & ":" & "A" & Final Hoja2.Range(miRangoDinamico).NumberFormat = "@"

Set Rango = Hoja2.Range(miRangoDinamico) For Each Celda In Rango Celda.Value = CStr(Celda) Next Celda End Sub Sub CodCuentaANumero() Dim Celda As Object Dim miRangoDinamico As String Dim Rango As Range Dim Final As Long Final = nReg(Hoja2, 2, 1) - 1 miRangoDinamico = "A" & 2 & ":" & "A" & Final Hoja2.Range(miRangoDinamico).NumberFormat = "General" Set Rango = Hoja2.Range(miRangoDinamico) For Each Celda In Rango Celda.Value = Val(Celda) Next Celda End Sub Sub IndexarCodCuentasPLAN() Call CodCuentaATexto Hoja2.Range("A:C").Sort key1:=Hoja2.Range("A2"), _ order1:=xlAscending, Header:=xlYes Call CodCuentaANumero End Sub Sub InsertarCuentadesdeListBox() If frm_ListadoCuentas.lbx_Cuentas.ListIndex = -1 Then MsgBox "Debe seleccionar una cuenta", vbInformation frm_ListadoCuentas.lbx_Cuentas.SetFocus Exit Sub End If Select Case banderaListadoCuentas Case 1 With frm_CatalogoCuentas .cbo_CodCuenta = frm_ListadoCuentas.lbx_Cuentas.Column(0) .txt_NombreCuenta = frm_ListadoCuentas.lbx_Cuentas.Column(1) Unload frm_ListadoCuentas End With

Case 2 With frm_LibroDiario .cbo_CodCuenta = frm_ListadoCuentas.lbx_Cuentas.Column(0) .txt_NombreCuenta = frm_ListadoCuentas.lbx_Cuentas.Column(1) Unload frm_ListadoCuentas End With Case Else MsgBox "La petición solicitada, aún no se ha establecido dentro de la declaración SELECT CASE", vbCritical End Select

End Sub Sub BuscarItemEnListBox() Dim i As Long Select Case banderaListadoCuentas Case 1 For i = 0 To frm_ListadoCuentas.lbx_Cuentas.ListCount - 1 If frm_ListadoCuentas.lbx_Cuentas.List(i, 0) = frm_CatalogoCuentas.cbo_CodCuenta Then frm_ListadoCuentas.lbx_Cuentas.ListIndex = i Exit For End If Next Case 2 For i = 0 To frm_ListadoCuentas.lbx_Cuentas.ListCount - 1 If frm_ListadoCuentas.lbx_Cuentas.List(i, 0) = frm_LibroDiario.cbo_CodCuenta Then frm_ListadoCuentas.lbx_Cuentas.ListIndex = i Exit For End If Next End Select End Sub Sub CambiarTamanoListboxCuentas() If banderaListadoCuentas = 1 Then frm_ListadoCuentas.Height = 125.25 frm_ListadoCuentas.lbx_Cuentas.Height = 75 End If End Sub Sub sumarDebe() Dim item As Long Dim totDebe As Currency On Error Resume Next

With frm_LibroDiario totDebe = 0 For item = 0 To frm_LibroDiario.lbx_DebeHaber.ListCount - 1 .lbx_DebeHaber.List(item, 2) = _ Replace(.lbx_DebeHaber.List(item, 2), Application.ThousandsSeparator, "") 'Aquí elimino el separador de miles .lbx_DebeHaber.List(item, 2) = _ Replace(.lbx_DebeHaber.List(item, 2), ",", ".") 'Ahora sustituyo la coma decimal por el punto decimal, para poder hacer la sumatoria con la variable totDebe, ya que con la coma decimal, no se suman los decimales totDebe = totDebe + Val(.lbx_DebeHaber.List(item, 2)) .lbx_DebeHaber.List(item, 2) = _ Replace(.lbx_DebeHaber.List(item, 2), ".", Application.DecimalSeparator) 'Aquí devuelvo el formato decimal para que no afecte al ListBox .lbx_DebeHaber.List(item, 2) = FormatNumber(.lbx_DebeHaber.List(item, 2), 2) 'Aqui doy formato de moneda para que aparezcan los separadores de miles y decimales Next item .lbl_SumaDebe.Caption = totDebe

.lbl_Diferencia.Caption = .lbl_SumaDebe.Caption - .lbl_SumaHaber.Caption If .lbl_SumaDebe.Caption - .lbl_SumaHaber.Caption = 0 Then .lbl_Diferencia.ForeColor = RGB(255, 255, 255) Else .lbl_Diferencia.ForeColor = RGB(255, 0, 0) End If

.lbl_Diferencia.Caption = FormatNumber(.lbl_Diferencia.Caption, 2) .lbl_SumaDebe.Caption = FormatNumber(.lbl_SumaDebe.Caption, 2) .lbl_SumaHaber.Caption = FormatNumber(.lbl_SumaHaber.Caption, 2)

End With End Sub Sub sumarhaber() Dim item As Long Dim totHaber As Currency On Error Resume Next With frm_LibroDiario

totHaber = 0 For item = 0 To frm_LibroDiario.lbx_DebeHaber.ListCount - 1

.lbx_DebeHaber.List(item, 3) = _ Replace(.lbx_DebeHaber.List(item, 3), Application.ThousandsSeparator, "") 'Aquí elimino el separador de miles .lbx_DebeHaber.List(item, 3) = _ Replace(.lbx_DebeHaber.List(item, 3), ",", ".") 'Ahora sustituyo la coma decimal por el punto decimal, para poder hacer la sumatoria con la variable totHaber, ya que con la coma decimal, no se suman los decimales totHaber = totHaber + Val(.lbx_DebeHaber.List(item, 3)) .lbx_DebeHaber.List(item, 3) = _ Replace(.lbx_DebeHaber.List(item, 3), ".", Application.DecimalSeparator) 'Aquí devuelvo el formato decimal para que no afecte al ListBox .lbx_DebeHaber.List(item, 3) = FormatNumber(.lbx_DebeHaber.List(item, 3), 2) Next item .lbl_SumaHaber.Caption = totHaber

.lbl_Diferencia.Caption = .lbl_SumaDebe.Caption - .lbl_SumaHaber.Caption If .lbl_SumaDebe.Caption - .lbl_SumaHaber.Caption = 0 Then .lbl_Diferencia.ForeColor = RGB(255, 255, 255) Else .lbl_Diferencia.ForeColor = RGB(255, 0, 0) End If

.lbl_Diferencia.Caption = FormatNumber(.lbl_Diferencia.Caption, 2) .lbl_SumaDebe.Caption = FormatNumber(.lbl_SumaDebe.Caption, 2) .lbl_SumaHaber.Caption = FormatNumber(.lbl_SumaHaber.Caption, 2)

End With End Sub Sub EnviarAMayor() Dim ccCelda As Range, ccRango As Range Dim ldCelda As Range, ldRango As Range Dim lmFila As Long

Application.ScreenUpdating = False

Hoja4.Activate ' Libro Mayor Cells.Select Selection.Clear

lmFila = 2

Hoja2.Activate ' Catálogo de Cuentas Set ccRango = Hoja2.Range(Cells(2, 1), Cells(2, 1).End(xlDown)) 'Preparando el Rango del Catálogo de Cuentas For Each ccCelda In ccRango ' Checando cada celda en el catálogo de cuentas Hoja2

If Len(ccCelda) = 3 Then Hoja3.Activate ' Libro Diario Set ldRango = Hoja3.Range(Cells(2, 4), Cells(2, 4).End(xlDown)) 'Preparando el Rango del Libro Diario For Each ldCelda In ldRango If ccCelda = Val(Mid(ldCelda.Offset(0, 0), 1, 3)) Then ' Comparo la CELDA de la hoja2 Catálogo de Cuentas, con la Hoja3 Libro Diario. ' y escribo los datos en la hoj4 Libro Mayor With Hoja4 .Cells(1, 1) = "CUENTA" .Cells(1, 2) = "NOMBRE DE LA CUENTA" .Cells(1, 3) = "#" .Cells(1, 4) = "FECHA" .Cells(1, 5) = "DEBE" .Cells(1, 6) = "HABER" .Cells(lmFila, 1) = ccCelda.Offset(0, 0).Value ' No. de Cuenta proviene de la hoja 2 .Cells(lmFila, 2) = ccCelda.Offset(0, 1).Value ' Nombre de la Cuenta proviene de la hoja 2

If ldCelda.Offset(0, -3) = Empty Then .Cells(lmFila, 3) = ldCelda.Offset(0, -3).End(xlUp) 'No. de Partida Else .Cells(lmFila, 3) = ldCelda.Offset(0, -3) 'No. de Partida End If If ldCelda.Offset(0, -2) = Empty Then .Cells(lmFila, 4) = Format(ldCelda.Offset(0, -2).End(xlUp), "MM/DD/YYYY") 'Fecha Else .Cells(lmFila, 4) = Format(ldCelda.Offset(0, -2), "MM/DD/YYYY") 'Fecha End If .Cells(lmFila, 5) = ldCelda.Offset(0, 2) 'DEBE .Cells(lmFila, 5).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

.Cells(lmFila, 6) = ldCelda.Offset(0, 3) 'HABER .Cells(lmFila, 6).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" .Range(.Cells(1, 1), .Cells(1, 6)).HorizontalAlignment = xlCenter .Range(.Cells(1, 1), .Cells(1, 6)).Interior.Color = RGB(190, 190, 90) .Range(.Cells(1, 1), .Cells(1, 6)).Font.Color = RGB(255, 255, 255) .Range(.Cells(1, 1), .Cells(1, 6)).Font.Bold = True End With lmFila = lmFila + 1 End If Next ldCelda End If Next ccCelda Call SepararCuentasMayor Call SumarDebeMayor Call SumarHaberMayor Call LimpiarRepetidosMayor Application.ScreenUpdating = True

End Sub Sub SepararCuentasMayor() Dim Fila As Long Dim Final As Long Hoja4.Activate Final = nReg(Hoja4, 2, 1) - 2 ' Le resto 2, para que no inserte un encabezado sin datos al final

With Hoja4 For Fila = Final To 2 Step -1 If .Cells(Fila + 1, 1) .Cells(Fila, 1) Then Rows(.Cells(Fila + 1, 1).Row & ":" & .Cells(Fila + 1, 1).Row + 1).Insert .Cells(Fila + 2, 1) = "CUENTA" .Cells(Fila + 2, 2) = "NOMBRE DE LA CUENTA" .Cells(Fila + 2, 3) = "#" .Cells(Fila + 2, 4) = "FECHA" .Cells(Fila + 2, 5) = "DEBE" .Cells(Fila + 2, 6) = "HABER" .Range(.Cells(Fila + 2, 1), .Cells(Fila + 2, 6)).HorizontalAlignment = xlCenter .Range(.Cells(Fila + 2, 1), .Cells(Fila + 2, 6)).Interior.Color = RGB(190, 190, 90) .Range(.Cells(Fila + 2, 1), .Cells(Fila + 2, 6)).Font.Color = RGB(255, 255, 255) .Range(.Cells(Fila + 2, 1), .Cells(Fila + 2, 6)).Font.Bold = True End If Next End With

End Sub Sub SumarDebeMayor() Dim i As Long Dim vDebe As Currency Dim Final As Long On Error Resume Next Hoja4.Range("A1").Activate Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0)) ActiveCell.Offset(2, 0).Select Loop Final = ActiveCell.Row

Hoja4.Range("E2").Activate For i = 1 To Evaluate("CountBlank(A1:A" & Final & ")") vDebe = 0 Do Until IsEmpty(ActiveCell.Offset(0, -4)) vDebe = vDebe + ActiveCell.Value ActiveCell.Offset(1, 0).Select Loop If vDebe 0 Then ActiveCell.Value = vDebe ActiveCell.Borders(xlEdgeTop).Color = RGB(0, 0, 0) ActiveCell.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" ActiveCell.Font.Bold = True ActiveCell.Offset(1, 0).Select Else ActiveCell.Offset(1, 0).Select End If Next i End Sub Sub SumarHaberMayor() Dim i As Long Dim Final As Long Dim vHaber As Currency On Error Resume Next Hoja4.Range("A1").Activate Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0)) ActiveCell.Offset(2, 0).Select Loop

Final = ActiveCell.Row

Hoja4.Range("F2").Activate For i = 1 To Evaluate("CountBlank(A1:A" & Final & ")") vHaber = 0 Do Until IsEmpty(ActiveCell.Offset(0, -5)) vHaber = vHaber + ActiveCell.Value ActiveCell.Offset(1, 0).Select Loop If vHaber 0 Then ActiveCell.Value = vHaber ActiveCell.Borders(xlEdgeTop).Color = RGB(0, 0, 0) ActiveCell.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" ActiveCell.Font.Bold = True ActiveCell.Offset(1, 0).Select Else ActiveCell.Offset(1, 0).Select End If Next i End Sub Sub LimpiarRepetidosMayor() Dim Fila As Long Dim Final As Long Hoja4.Range("A1").Activate Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0)) ActiveCell.Offset(2, 0).Select Loop Final = ActiveCell.Row

For Fila = Final To 2 Step -1 If Hoja4.Cells(Fila + 1, 1) = Hoja4.Cells(Fila, 1) Then Hoja4.Cells(Fila + 1, 1) = Empty Hoja4.Cells(Fila + 1, 2) = Empty End If Next Hoja4.Range("A1").Activate End Sub Sub ConstruirBalancedeComprobacion()

Dim ccCelda As Range, ccRango As Range Dim ldCelda As Range, ldRango As Range Dim bcFila As Long Application.ScreenUpdating = False Hoja5.Activate ' Activar la hoja Balance de Comprobación Cells.Select Selection.Clear

bcFila = 2 Hoja2.Activate ' Catálogo de Cuentas Set ccRango = Hoja2.Range(Cells(2, 1), Cells(2, 1).End(xlDown)) 'Preparando el Rango del Catálogo de Cuentas For Each ccCelda In ccRango With Hoja5 If Len(ccCelda) = 3 Then Hoja3.Activate ' Libro Diario Set ldRango = Hoja3.Range(Cells(2, 4), Cells(2, 4).End(xlDown)) 'Preparando el Rango del Libro Diario For Each ldCelda In ldRango If ccCelda = Val(Mid(ldCelda.Offset(0, 0), 1, 3)) Then ' Comparo la CELDA de la hoja2 Catálogo de Cuentas, con la Hoja3 Libro Diario. .Cells(1, 1) = "CUENTA" .Cells(1, 2) = "NOMBRE DE LA CUENTA" .Cells(1, 3) = "DEBE" .Cells(1, 4) = "HABER" .Cells(1, 5) = "SALDO DEUDOR" .Cells(1, 6) = "SALDO ACREEDOR" 'Dando formato al encabezado .Range(.Cells(1, 1), .Cells(1, 6)).HorizontalAlignment = xlCenter .Range(.Cells(1, 1), .Cells(1, 6)).Interior.Color = RGB(100, 190, 190) .Range(.Cells(1, 1), .Cells(1, 6)).Font.Color = RGB(255, 255, 255) .Range(.Cells(1, 1), .Cells(1, 6)).Font.Bold = True .Cells(bcFila, 1) = ccCelda.Offset(0, 0).Value 'Cuenta .Cells(bcFila, 2) = ccCelda.Offset(0, 1).Value 'Nombre de Cuenta .Cells(bcFila, 3) = ldCelda.Offset(0, 2) 'DEBE .Cells(bcFila, 3).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" .Cells(bcFila, 4) = ldCelda.Offset(0, 3) 'HABER .Cells(bcFila, 4).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

bcFila = bcFila + 1 End If Next ldCelda End If

End With Next ccCelda Call SepararCuentasComprobacion Call SumarDebeHaberComprobacion Call ConsolidarBalanceComprobacion Call TotalizarBalanceComprobacion Application.ScreenUpdating = True End Sub Sub SepararCuentasComprobacion() Dim Fila As Long Dim Final As Long Hoja5.Activate ' Balance de Comprobación Final = nReg(Hoja5, 2, 1) - 1 With Hoja5 For Fila = Final To 2 Step -1 If .Cells(Fila + 1, 1) .Cells(Fila, 1) Then Rows(.Cells(Fila + 1, 1).Row & ":" & .Cells(Fila + 1, 1).Row).Insert End If Next End With End Sub

Sub SumarDebeHaberComprobacion() Dim i As Long Dim vDebeHaber As Currency Dim sDeudor As Currency Dim Final As Long Dim j As Long Hoja5.Range("A1").Activate Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0)) ActiveCell.Offset(2, 0).Select Loop Final = ActiveCell.Row

For j = 3 To 5 Hoja5.Cells(2, j).Activate For i = 1 To Evaluate("CountBlank(A1:A" & Final & ")") vDebeHaber = 0

Do Until IsEmpty(ActiveCell.Offset(0, 1 - j)) vDebeHaber = vDebeHaber + ActiveCell.Value ActiveCell.Font.Bold = True ActiveCell.Offset(1, 0).Select Loop

If j = 5 And ActiveCell.Offset(0, -1) Empty Or ActiveCell.Offset(0, -2) Empty Then ActiveCell.Offset(0, -4) = ActiveCell.Offset(-1, -4) ActiveCell.Offset(0, -3) = ActiveCell.Offset(-1, -3) End If

If vDebeHaber 0 Then ActiveCell.Value = vDebeHaber ActiveCell.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" ActiveCell.Offset(1, 0).Select Else ActiveCell.Offset(1, 0).Select End If Next i Next j End Sub Sub ConsolidarBalanceComprobacion() Dim Fila As Long Dim Final As Long

Hoja5.Range("A1").Activate Do Until IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop

Final = ActiveCell.Row

For Fila = Final To 2 Step -1 If Hoja5.Cells(Fila, 3).Font.Bold = True Then Hoja5.Cells(Fila, 1).EntireRow.Delete End If Next

Hoja5.Range("A1").Activate End Sub Sub TotalizarBalanceComprobacion() Dim vTotalMoneda As Currency Dim i As Long

' Totalizo los valores de moneda For i = 3 To 6 Hoja5.Cells(2, i).Activate vTotalMoneda = 0 Do Until IsEmpty(ActiveCell.Offset(0, 1 - i)) If i = 5 Then ' Genero el saldo deudor If ActiveCell.Offset(0, -2) - ActiveCell.Offset(0, -1).Value > 0 Then ActiveCell.Value = ActiveCell.Offset(0, -2) - ActiveCell.Offset(0, -1).Value ActiveCell.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" End If End If If i = 6 Then ' Genero el saldo acreedor If ActiveCell.Offset(0, -3) - ActiveCell.Offset(0, -2).Value < 0 Then ActiveCell.Value = ActiveCell.Offset(0, -3) - ActiveCell.Offset(0, -2).Value ActiveCell.Value = Replace(ActiveCell.Value, "-", "") ActiveCell.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" End If End If vTotalMoneda = vTotalMoneda + ActiveCell.Value ActiveCell.Offset(1, 0).Select Loop If i = 6 Then 'Trazo una línea en la parte superior de los totales Hoja5.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, -5)).Borders(xlEdgeTop).Color = RGB(190, 190, 190) End If ActiveCell.Value = vTotalMoneda ActiveCell.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" ActiveCell.Font.Bold = True ActiveCell.Offset(1, 0).Select Next i Hoja5.Range("A1").Activate End Sub Sub BalanceGeneral()

Dim Celda As Range, Rango As Range, rBuscar As Range Dim Fila As Long, ultFila As Long Dim totACorriente As Currency, totAnoCorriente As Currency, totActivos As Currency Dim totPCorriente As Currency, totPnoCorriente As Currency, totPatrimonio As Currency, totPasivos As Currency Dim sEmpresa As String, FechaBalance As String, TipoMoneda As String Dim fRepresentante As String, fContador As String, fAuditor As String Application.ScreenUpdating = False

'/////////////// ENCABEZADO ////////////////////

sEmpresa = InputBox("Nombre de la Empresa: ") If sEmpresa = Empty Then Exit Sub FechaBalance = InputBox("Período del Balance: ") If FechaBalance = Empty Then Exit Sub TipoMoneda = InputBox("Escriba la moneda expresada: ") If TipoMoneda = Empty Then Exit Sub '/////////////// CAPTURANDO NOMBRES PARA LAS FIRMAS //////////////////// fRepresentante = InputBox("Firma del Representante Legal o Apoderado: ") If fRepresentante = Empty Then Exit Sub fContador = InputBox("Firma del Contador General: ") If fContador = Empty Then Exit Sub fAuditor = InputBox("Firma del Auditor Externo: ") If fAuditor = Empty Then Exit Sub

'/////////////// ACTIVO //////////////////// ultFila = 0 Fila = 7 With Hoja6 Hoja5.Activate ' Balance de Comprobación Set Rango = Hoja5.Range(Cells(2, 1), Cells(2, 1).End(xlDown)) 'Preparando el Rango del Balance de Comprobación .Activate .Cells(1, 1) = sEmpresa .Cells(1, 1).Font.Bold = True .Cells(1, 1).HorizontalAlignment = xlCenter .Range(Cells(1, 1), Cells(1, 7)).Merge .Cells(2, 1) = FechaBalance .Cells(2, 1).Font.Bold = True .Cells(2, 1).HorizontalAlignment = xlCenter .Range(Cells(2, 1), Cells(2, 7)).Merge

.Cells(3, 1) = TipoMoneda .Cells(3, 1).HorizontalAlignment = xlCenter .Range(Cells(3, 1), Cells(3, 7)).Merge .Cells(Fila - 2, 1) = "ACTIVO" .Cells(Fila - 2, 1).HorizontalAlignment = xlCenter .Range(Cells(Fila - 2, 1), Cells(Fila - 2, 3)).Merge .Cells(Fila - 2, 1).Font.Bold = True .Cells(Fila - 1, 1) = "Corriente" .Cells(Fila - 1, 1).Font.Bold = True totACorriente = 0 For Each Celda In Rango If Mid(Celda, 1, 2) = 10 Or Mid(Celda, 1, 2) = 11 Then .Cells(Fila, 1) = Celda.Offset(0, 1).Value 'Nombre de Cuenta .Cells(Fila, 2) = Celda.Offset(0, 4).Value 'Saldo Deudor .Cells(Fila, 2).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" totACorriente = totACorriente + Celda.Offset(0, 4).Value Fila = Fila + 1 End If Next Celda .Cells(Fila - 1, 2).Borders(xlEdgeBottom).Color = RGB(0, 0, 0) Fila = Fila + 2 .Cells(Fila - 1, 1) = "No Corriente" .Cells(Fila - 1, 1).Font.Bold = True totAnoCorriente = 0 For Each Celda In Rango If Mid(Celda, 1, 2) = 12 Then .Cells(Fila, 1) = Celda.Offset(0, 1).Value 'Nombre de Cuenta .Cells(Fila, 2) = Celda.Offset(0, 4).Value 'Saldo Deudor .Cells(Fila, 2).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" totAnoCorriente = totAnoCorriente + Celda.Offset(0, 4).Value Fila = Fila + 1 End If Next Celda .Cells(Fila - 1, 2).Borders(xlEdgeBottom).Color = RGB(0, 0, 0) '/////////////// PASIVO //////////////////// Fila = 7 .Cells(Fila - 2, 5) = "PASIVO" .Cells(Fila - 2, 5).HorizontalAlignment = xlCenter .Range(Cells(Fila - 2, 5), Cells(Fila - 2, 7)).Merge .Cells(Fila - 2, 5).Font.Bold = True .Cells(Fila - 1, 5) = "Corriente" .Cells.Cells(Fila - 1, 5).Font.Bold = True totPCorriente = 0 For Each Celda In Rango If Mid(Celda, 1, 2) = 20 Then

.Cells(Fila, 5) = Celda.Offset(0, 1).Value 'Nombre de Cuenta .Cells(Fila, 6) = Celda.Offset(0, 5).Value 'Saldo Acreedor .Cells(Fila, 6).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" totPCorriente = totPCorriente + Celda.Offset(0, 5).Value Fila = Fila + 1 End If Next Celda .Cells(Fila - 1, 6).Borders(xlEdgeBottom).Color = RGB(0, 0, 0) Fila = Fila + 2 .Cells(Fila - 1, 5) = "No Corriente" .Cells(Fila - 1, 5).Font.Bold = True totPnoCorriente = 0 For Each Celda In Rango If Mid(Celda, 1, 2) = 21 Then .Cells(Fila, 5) = Celda.Offset(0, 1).Value 'Nombre de Cuenta .Cells(Fila, 6) = Celda.Offset(0, 5).Value 'Saldo Acreedor .Cells(Fila, 6).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" totPnoCorriente = totPnoCorriente + Celda.Offset(0, 5).Value Fila = Fila + 1 End If Next Celda .Cells(Fila - 1, 6).Borders(xlEdgeBottom).Color = RGB(0, 0, 0) Fila = Fila + 2 .Cells(Fila - 1, 5) = "Patrimonio" .Cells(Fila - 1, 5).Font.Bold = True totPatrimonio = 0 For Each Celda In Rango If Mid(Celda, 1, 2) = 30 Or Mid(Celda, 1, 2) = 40 Then .Cells(Fila, 5) = Celda.Offset(0, 1).Value 'Nombre de Cuenta .Cells(Fila, 6) = Celda.Offset(0, 5).Value 'Saldo Acreedor .Cells(Fila, 6).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" totPatrimonio = totPatrimonio + Celda.Offset(0, 5).Value Fila = Fila + 1 End If Next Celda .Cells(Fila - 1, 6).Borders(xlEdgeBottom).Color = RGB(0, 0, 0) .Activate .Range("A1").Select '/////////////// TOTALES //////////////////// totActivos = totACorriente + totAnoCorriente totPasivos = totPCorriente + totPnoCorriente + totPatrimonio Set rBuscar = .Range("A:A").Find("Corriente", LookIn:=xlValues) rBuscar.Offset(0, 2).Value = totACorriente rBuscar.Offset(0, 2).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

rBuscar.Offset(0, 2).Font.Bold = True Set rBuscar = .Range("A:A").Find("No Corriente", LookIn:=xlValues) rBuscar.Offset(0, 2).Value = totAnoCorriente rBuscar.Offset(0, 2).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" rBuscar.Offset(0, 2).Font.Bold = True Set rBuscar = .Range("E:E").Find("Corriente", LookIn:=xlValues) rBuscar.Offset(0, 2).Value = totPCorriente rBuscar.Offset(0, 2).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" rBuscar.Offset(0, 2).Font.Bold = True Set rBuscar = .Range("E:E").Find("No Corriente", LookIn:=xlValues) rBuscar.Offset(0, 2).Value = totPnoCorriente rBuscar.Offset(0, 2).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" rBuscar.Offset(0, 2).Font.Bold = True Set rBuscar = .Range("E:E").Find("Patrimonio", LookIn:=xlValues) rBuscar.Offset(0, 2).Value = totPatrimonio rBuscar.Offset(0, 2).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" rBuscar.Offset(0, 2).Font.Bold = True 'ThisWorkbook.Save ultFila = .Cells.SpecialCells(xlCellTypeLastCell).Row + 3 .Cells(ultFila, 1) = "Total Activos:" .Cells(ultFila, 1).Font.Bold = True .Cells(ultFila, 3) = totActivos .Cells(ultFila, 3).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" .Cells(ultFila, 3).Font.Bold = True .Cells(ultFila, 3).Borders(xlEdgeTop).Color = RGB(0, 0, 0) .Cells(ultFila, 3).Borders(xlEdgeBottom).LineStyle = xlDouble .Cells(ultFila, 5) = "Total Pasivo y Patrimonio:" .Cells(ultFila, 5).Font.Bold = True .Cells(ultFila, 7) = totPasivos .Cells(ultFila, 7).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)" .Cells(ultFila, 7).Font.Bold = True .Cells(ultFila, 7).Borders(xlEdgeTop).Color = RGB(0, 0, 0) .Cells(ultFila, 7).Borders(xlEdgeBottom).LineStyle = xlDouble

'/////////////// FIRMAS //////////////////// ultFila = ultFila + 5 .Cells(ultFila, 1) = fRepresentante .Cells(ultFila, 1).HorizontalAlignment = xlCenter .Cells(ultFila, 3) = fContador .Cells(ultFila, 3).HorizontalAlignment = xlCenter .Range(Cells(ultFila, 3), Cells(ultFila, 4)).Merge .Cells(ultFila, 6) = fAuditor .Cells(ultFila, 6).HorizontalAlignment = xlCenter .Range(Cells(ultFila, 6), Cells(ultFila, 7)).Merge ultFila = ultFila + 1

.Cells(ultFila, 1) = "REPRESENTANTE LEGAL O APODERADO" .Cells(ultFila, 1).HorizontalAlignment = xlCenter .Cells(ultFila - 1, 1).Borders(xlEdgeTop).Color = RGB(0, 0, 0) .Cells(ultFila, 3) = "CONTADOR GENERAL" .Cells(ultFila, 3).HorizontalAlignment = xlCenter .Range(Cells(ultFila, 3), Cells(ultFila, 4)).Merge .Range(Cells(ultFila - 1, 3), Cells(ultFila, 4)).Borders(xlEdgeTop).Color = RGB(0, 0, 0) .Cells(ultFila, 6) = "AUDITOR EXTERNO, REG.#" .Cells(ultFila, 6).HorizontalAlignment = xlCenter .Range(Cells(ultFila, 6), Cells(ultFila, 7)).Merge .Range(Cells(ultFila - 1, 6), Cells(ultFila, 7)).Borders(xlEdgeTop).Color = RGB(0, 0, 0) .btn_BalanceGeneral.Caption = "Limpiar" End With Application.ScreenUpdating = True End Sub

SEPARADOR DECIMAL Option Explicit Dim Registro_Win As WshShell Private Const MaquinaLocal As String = "HKEY_LOCAL_MACHINE" Private Const UsuarioActual As String = "HKEY_CURRENT_USER" Function LecturaDeRegistro(Usuario As String, Valor As String) As String LecturaDeRegistro = Registro_Win.RegRead(Usuario & "\Control Panel\International\" & Valor) End Function Sub infoSeparadorDecimal() Set Registro_Win = New WshShell Hoja1.Range("L2") = LecturaDeRegistro(UsuarioActual, "sMonDecimalSep") End Sub Sub Formato_Americano() With Application .UseSystemSeparators = False .DecimalSeparator = "." .ThousandsSeparator = "," End With End Sub Sub Formato_Europeo() With Application .UseSystemSeparators = False .DecimalSeparator = "," .ThousandsSeparator = "." End With End Sub