SIMCAN v1.0 VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "Hoja1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = True Private Sub Worksheet_Activate() ActiveWindow.DisplayGridlines = False ActiveWindow.DisplayHeadings = False ActiveWindow.DisplayHorizontalScrollBar = False ActiveWindow.DisplayVerticalScrollBar = False End Sub Private Sub Worksheet_Deactivate() ActiveWindow.DisplayGridlines = True ActiveWindow.DisplayHeadings = True ActiveWindow.DisplayHorizontalScrollBar = True ActiveWindow.DisplayVerticalScrollBar = True End Sub VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "ThisWorkbook" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = True Private Sub Workbook_Open() AVISSORTIR = False OBRIR = 1 NOM_IRPF_DADES = ThisWorkbook.Path & "\DADES\IRPF" NOM_IRPF_SIMUL = ThisWorkbook.Path & "\SIMUL\IRPF\" NOM_IS_DADES = ThisWorkbook.Path & "\DADES\IS" NOM_IS_SIMUL = ThisWorkbook.Path & "\SIMUL\IS\" NOM_ID_DADES = ThisWorkbook.Path & "\DADES\ISD" NOM_ID_SIMUL = ThisWorkbook.Path & "\SIMUL\ISD\" NOM_IT_DADES = ThisWorkbook.Path & "\DADES\IT" NOM_IT_SIMUL = ThisWorkbook.Path & "\SIMUL\ITPOAJDOS\" NOM_IPPF_DADES = ThisWorkbook.Path & "\DADES\IPPF" NOM_IPPF_SIMUL = ThisWorkbook.Path & "\SIMUL\IPPF\" Call COMUNS_0CREAR(1) Sheets("SIMULADOR REFORMES IMPOSITIVES").Activate End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) If Not AVISSORTIR Then Call COMUNS_0ESBORRAR(1) Application.Quit End Sub Attribute VB_Name = "Comuns" Option Explicit Public AVISSORTIR As Boolean, COMPARA As Integer, CTL As Control, ERR_LEC As Boolean, IDENTIFICADOR() As Long, _ LLIBRE_FORMATS As Workbook, LLIBRE_PROJECCIONS As Workbook, LLIBRE_REFERENCIA As Workbook, _ LLIBRE_RESULTATS As Workbook, N As Long, N1 As Long, N2 As Long, N3 As Long, NT As Double, NT1 As Double, _ NT2 As Double, NT3 As Double, OBRIR As Integer, PAGINA As Integer, RES As Integer, SIMUL As Integer, SORTIR As Boolean Public COEF() As Double, COMP(1 To 2) As Integer, IMPOST(1 To 5) As Boolean, IND() As Long, _ IRESULTS() As Integer, ISIMULS(1 To 5) As Integer, MITJANA() As Double, NTRAMS As Integer, PAG() As Double, _ PARMS(), PROJ(1 To 5) As Double, SUMA() As Double, T() As Double, TIPUS() As Double, VT(), X() As Double, y() As Double Public IRPF_ANYREF, IRPF_DD_RT(), IRPF_DA(), IRPF_EXEMPTE, IRPF_MPF(), _ IRPF_NTRAMSE, IRPF_NTRAMSG(1 To 2), IRPF_RED_PER(), IRPF_RED_PP(), IRPF_RED_RT(), IRPF_RED_RTC(), _ IRPF_TIPUSG(), IRPF_TIPUSE(), IRPF_TRAMSE(), IRPF_TRAMSG() Public ANOIRPF, A_PROJ, ANY_PROJ, C_PROJ() As Double, C_BASE As Integer, DECL_NOMBRE As String, DECL_PROJ As String, DEFLACTOR As Double, _ LIM_BASE As Double, MINIM_EXEMPTE As Double, NOM_IRPF_DADES As String, NOM_IRPF_SIMUL As String, _ NDEDA As Integer, NTRAMSE As Integer Public AIRPF(), CATEG() As Integer, CIRPF() As Integer, DEDA() As Double, _ DDRT() As Double, DEDV() As Double, MPF() As Double, NTRAMSG() As Integer, RPER() As Double, RPP() As Double, RT() As Double, _ RTC() As Double, TE() As Double, TIPUSE() As Double, TG() As Double, TIPUSG() As Double Public IS_ANYREF, IS_BON(), IS_COEF(), IS_NTRAMS, IS_NTRAMS_BON, IS_R301(), IS_R302(), IS_R303(), IS_R305(), IS_R306(), IS_R307(), _ IS_R308(), IS_R309(), IS_R310(), IS_R311(), IS_R312(), IS_TIPUS(), IS_TRAMS() Public ANOIS, NOM_IS_DADES As String, NOM_IS_SIMUL As String, NTRAMS_BON_IS As Integer Public AIS(), BON_IS() As Double, CIS() As Integer, PER_BON_REDS As Double, R301() As Double, R302() As Double, R303() As Double, R305() As Double, _ R306() As Double, R307() As Double, R308() As Double, R309() As Double, R310() As Double, R311() As Double, R312() As Double, R2011 As Boolean Public ID_ANYREF, ID_COEF(), ID_D_QUOTA(), ID_NTRAMS12, ID_NTRAMS34, ID_R_BASE(), ID_TIPUS12(), ID_TIPUS34(), _ ID_TRAMS12(), ID_TRAMS34() Public AID(), ANOID, BON_ID() As Double, CID() As Integer, D_QUOTA() As Double, NOM_ID_DADES As String, NOM_ID_SIMUL As String, _ NTRAMS12 As Integer, NTRAMS34 As Integer, R_BASE() As Double, T12() As Double, T34() As Double, _ TIPUS12() As Double, TIPUS34() As Double Public IT_ANYREF, IT_NTRAMSTUB As Integer, IT_TARIFA_AJD() As String, IT_TARIFA_OS() As String, IT_TARIFA_TPO() As String, _ IT_TIPUS_AJD(), IT_TIPUS_OS(), IT_TIPUS_TPO(), IT_TIPUSTUB(), IT_TRAMSTUB(), IT_BON_TUB As Double Public AIT(), ANOIT, BON_IT_TUB As Double, CIT() As Integer, NOM_IT_DADES As String, NOM_IT_SIMUL As String, NTRAMSTUB As Integer, _ TIPUS_TPO() As Double, TIPUSTUB() As Double, TRAMSTUB() As Double, TIPUS_OS() As Double, TIPUS_AJD() As Double Public IPPF_ANYREF, IPPF_E() As Integer, IPPF_LIM(1 To 2), IPPF_ME() As Long, IPPF_NTRAMS, IPPF_OP(1 To 2), _ IPPF_TIPUS(), IPPF_TRAMS() Public ANOIPPF, BENS_E() As Integer, CONNEXIO_IRPF As Boolean, LBQ As Double, LIMITS() As Double, LVAR() As String, _ MINIMS_E() As Long, NOM_IPPF_DADES As String, NOM_IPPF_SIMUL As String, REDUCCIO(1 To 2) As Long, SP() As Long Public AIPPF(), CIPPF() As Integer Public Const TITOL_IRPF As String * 11 = "SIMCAN-IRPF", _ TITOL_IS As String * 9 = "SIMCAN-IS", _ TITOL_ID As String * 9 = "SIMCAN-ID", _ TITOL_IT As String * 13 = "SIMCAN-ITPOOSAJD", _ TITOL_IPPF As String * 11 = "SIMCAN-IPPF", _ SECRET As String * 18 = "36965422Y37274989Q" Sub COMUNS_0CREAR(opcio As Integer) Dim AjudaMenu As CommandBarControl, SMenu As CommandBarPopup On Error Resume Next Set SMenu = CommandBars(1).Controls("SIMCAN(v1.0) " & Chr(169) & " " & Chr(174)) If SMenu Is Nothing Then Set AjudaMenu = CommandBars(1).FindControl(ID:=30010) If AjudaMenu Is Nothing Then Set SMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup, Temporary:=True) Else Set SMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup, Temporary:=True, Before:=AjudaMenu.Index) End If With SMenu .Caption = "&SIMCAN(v1.0) " & Chr(169) & " " & Chr(174) .BeginGroup = True .OnAction = "SIMCAN_IMPOSTOS" End With End If End Sub Sub COMUNS_0ESBORRAR(opcio As Integer) Dim SMenu As CommandBarPopup Set SMenu = CommandBars(1).Controls("SIMCAN(v1.0) " & Chr(169) & " " & Chr(174)) SMenu.Delete End Sub Sub COMUNS_0NETEJA(full As String) Dim i1 As Integer, i2 As Integer i2 = Sheets.Count If i2 > 1 Then ActiveWorkbook.Unprotect (SECRET) For i1 = 2 To Sheets.Count If Sheets(i1).Name = full Then Sheets(i1).Delete Exit For End If Next i1 ActiveWorkbook.Protect (SECRET) End If End Sub Sub COMUNS_0NOMSFULLS(full As String) Dim f(10) As String, i1 As Integer, i2 As Integer ActiveWorkbook.Unprotect (SECRET) i2 = Sheets.Count f(0) = "SIMULADOR REFORMAS IMPOSITIVAS" If i2 > 1 Then For i1 = 2 To Sheets.Count If Sheets(i1).Name = "IRPF(R)" Then f(1) = "IRPF(R)" If Sheets(i1).Name = "IRPF(G-P)" Then f(2) = "IRPF(G-P)" If Sheets(i1).Name = "IS(R)" Then f(3) = "IS(R)" If Sheets(i1).Name = "IS(G-P)" Then f(4) = "IS(G-P)" If Sheets(i1).Name = "ID(R)" Then f(5) = "ID(R)" If Sheets(i1).Name = "ID(G-P)" Then f(6) = "ID(G-P)" If Sheets(i1).Name = "ITPOOSAJD(R)" Then f(7) = "ITPOOSAJD(R)" If Sheets(i1).Name = "ITPOOSAJD(G-P)" Then f(8) = "ITPOOSAJD(G-P)" If Sheets(i1).Name = "IPPF(R)" Then f(9) = "IPPF(R)" If Sheets(i1).Name = "IPPF(G-P)" Then f(10) = "IPPF(G-P)" Next i1 End If If full = "IRPF(R)" Or full = "IS(R)" Or full = "ID(R)" Or full = "ITPOOSAJD(R)" Or full = "IPPF(R)" Then If full = "IRPF(R)" Then If f(2) <> "" Then Sheets.Add(Before:=Sheets(f(2)), Count:=1).Name = "IRPF(R)" Else Sheets.Add(After:=Sheets(f(0)), Count:=1).Name = "IRPF(R)" End If ElseIf full = "IS(R)" Then If f(4) <> "" Then Sheets.Add(Before:=Sheets(f(4)), Count:=1).Name = "IS(R)" Else If f(2) <> "" Then Sheets.Add(After:=Sheets(f(2)), Count:=1).Name = "IS(R)" ElseIf f(1) <> "" Then Sheets.Add(After:=Sheets(f(1)), Count:=1).Name = "IS(R)" Else Sheets.Add(After:=Sheets(f(0)), Count:=1).Name = "IS(R)" End If End If ElseIf full = "ID(R)" Then If f(6) <> "" Then Sheets.Add(Before:=Sheets(f(6)), Count:=1).Name = "ID(R)" Else If f(4) <> "" Then Sheets.Add(After:=Sheets(f(4)), Count:=1).Name = "ID(R)" ElseIf f(3) <> "" Then Sheets.Add(After:=Sheets(f(3)), Count:=1).Name = "ID(R)" ElseIf f(2) <> "" Then Sheets.Add(After:=Sheets(f(2)), Count:=1).Name = "ID(R)" ElseIf f(1) <> "" Then Sheets.Add(After:=Sheets(f(1)), Count:=1).Name = "ID(R)" Else Sheets.Add(After:=Sheets(f(0)), Count:=1).Name = "ID(R)" End If End If ElseIf full = "ITPOOSAJD(R)" Then If f(6) <> "" Then Sheets.Add(After:=Sheets(f(6)), Count:=1).Name = "ITPOOSAJD(R)" ElseIf f(5) <> "" Then Sheets.Add(After:=Sheets(f(5)), Count:=1).Name = "ITPOOSAJD(R)" ElseIf f(4) <> "" Then Sheets.Add(After:=Sheets(f(4)), Count:=1).Name = "ITPOOSAJD(R)" ElseIf f(3) <> "" Then Sheets.Add(After:=Sheets(f(3)), Count:=1).Name = "ITPOOSAJD(R)" ElseIf f(2) <> "" Then Sheets.Add(After:=Sheets(f(2)), Count:=1).Name = "ITPOOSAJD(R)" ElseIf f(1) <> "" Then Sheets.Add(After:=Sheets(f(1)), Count:=1).Name = "ITPOOSAJD(R)" Else Sheets.Add(After:=Sheets(f(0)), Count:=1).Name = "ITPOOSAJD(R)" End If ElseIf full = "IPPF(R)" Then If f(8) <> "" Then Sheets.Add(After:=Sheets(f(8)), Count:=1).Name = "IPPF(R)" ElseIf f(7) <> "" Then Sheets.Add(After:=Sheets(f(7)), Count:=1).Name = "IPPF(R)" ElseIf f(6) <> "" Then Sheets.Add(After:=Sheets(f(6)), Count:=1).Name = "IPPF(R)" ElseIf f(5) <> "" Then Sheets.Add(After:=Sheets(f(5)), Count:=1).Name = "IPPF(R)" ElseIf f(4) <> "" Then Sheets.Add(After:=Sheets(f(4)), Count:=1).Name = "IPPF(R)" ElseIf f(3) <> "" Then Sheets.Add(After:=Sheets(f(3)), Count:=1).Name = "IPPF(R)" ElseIf f(2) <> "" Then Sheets.Add(After:=Sheets(f(2)), Count:=1).Name = "IPPF(R)" ElseIf f(1) <> "" Then Sheets.Add(After:=Sheets(f(1)), Count:=1).Name = "IPPF(R)" Else Sheets.Add(After:=Sheets(f(0)), Count:=1).Name = "IPPF(R)" End If End If ElseIf full = "IRPF(G-P)" Or full = "IS(G-P)" Or full = "ID(G-P)" Or full = "ITPOOSAJD(G-P)" Or full = "IPPF(G-P)" Then If full = "IRPF(G-P)" Then If f(1) <> "" Then Sheets.Add(After:=Sheets(f(1)), Count:=1).Name = "IRPF(G-P)" Else Sheets.Add(After:=Sheets(f(0)), Count:=1).Name = "IRPF(G-P)" End If ElseIf full = "IS(G-P)" Then If f(3) <> "" Then Sheets.Add(After:=Sheets(f(3)), Count:=1).Name = "IS(G-P)" Else If f(2) <> "" Then Sheets.Add(After:=Sheets(f(2)), Count:=1).Name = "IS(G-P)" ElseIf f(1) <> "" Then Sheets.Add(After:=Sheets(f(1)), Count:=1).Name = "IS(G-P)" Else Sheets.Add(After:=Sheets(f(0)), Count:=1).Name = "IS(G-P)" End If End If ElseIf full = "ID(G-P)" Then If f(5) <> "" Then Sheets.Add(After:=Sheets(f(5)), Count:=1).Name = "ID(G-P)" Else If f(4) <> "" Then Sheets.Add(After:=Sheets(f(4)), Count:=1).Name = "ID(G-P)" ElseIf f(3) <> "" Then Sheets.Add(After:=Sheets(f(3)), Count:=1).Name = "ID(G-P)" ElseIf f(2) <> "" Then Sheets.Add(After:=Sheets(f(2)), Count:=1).Name = "ID(G-P)" ElseIf f(1) <> "" Then Sheets.Add(After:=Sheets(f(1)), Count:=1).Name = "ID(G-P)" Else Sheets.Add(After:=Sheets(f(0)), Count:=1).Name = "ID(G-P)" End If End If ElseIf full = "ITPOOSAJD(G-P)" Then If f(7) <> "" Then Sheets.Add(After:=Sheets(f(7)), Count:=1).Name = "ITPOOSAJD(G-P)" Else If f(6) <> "" Then Sheets.Add(After:=Sheets(f(6)), Count:=1).Name = "ITPOOSAJD(G-P)" ElseIf f(5) <> "" Then Sheets.Add(After:=Sheets(f(5)), Count:=1).Name = "ITPOOSAJD(G-P)" ElseIf f(4) <> "" Then Sheets.Add(After:=Sheets(f(4)), Count:=1).Name = "ITPOOSAJD(G-P)" ElseIf f(3) <> "" Then Sheets.Add(After:=Sheets(f(3)), Count:=1).Name = "ITPOOSAJD(G-P)" ElseIf f(2) <> "" Then Sheets.Add(After:=Sheets(f(2)), Count:=1).Name = "ITPOOSAJD(G-P)" ElseIf f(1) <> "" Then Sheets.Add(After:=Sheets(f(1)), Count:=1).Name = "ITPOOSAJD(G-P)" Else Sheets.Add(After:=Sheets(f(0)), Count:=1).Name = "ITPOOSAJD(G-P)" End If End If ElseIf full = "IPPF(G-P)" Then If f(9) <> "" Then Sheets.Add(After:=Sheets(f(9)), Count:=1).Name = "IPPF(G-P)" Else If f(8) <> "" Then Sheets.Add(After:=Sheets(f(8)), Count:=1).Name = "IPPF(G-P)" ElseIf f(7) <> "" Then Sheets.Add(After:=Sheets(f(7)), Count:=1).Name = "IPPF(G-P)" ElseIf f(6) <> "" Then Sheets.Add(After:=Sheets(f(6)), Count:=1).Name = "IPPF(G-P)" ElseIf f(5) <> "" Then Sheets.Add(After:=Sheets(f(5)), Count:=1).Name = "IPPF(G-P)" ElseIf f(4) <> "" Then Sheets.Add(After:=Sheets(f(4)), Count:=1).Name = "IPPF(G-P)" ElseIf f(3) <> "" Then Sheets.Add(After:=Sheets(f(3)), Count:=1).Name = "IPPF(G-P)" ElseIf f(2) <> "" Then Sheets.Add(After:=Sheets(f(2)), Count:=1).Name = "IPPF(G-P)" ElseIf f(1) <> "" Then Sheets.Add(After:=Sheets(f(1)), Count:=1).Name = "IPPF(G-P)" Else Sheets.Add(After:=Sheets(f(0)), Count:=1).Name = "IPPF(G-P)" End If End If End If End If ActiveWorkbook.Protect (SECRET) End Sub Sub COMUNS_1REFERENCIA(tipus_impost As String) Dim auxe As Integer, auxg As Integer, i1 As Integer If tipus_impost = "IRPF" Then IRPF_ANYREF = 2017 ReDim IRPF_MPF(1 To 13, 1 To 2) 'Minims personals IRPF_MPF(1, 1) = 5550 'general IRPF_MPF(2, 1) = 2400 '1er fill IRPF_MPF(3, 1) = 2700 '2on. fill IRPF_MPF(4, 1) = 4000 '3er. fill IRPF_MPF(5, 1) = 4500 '4art. fill IRPF_MPF(6, 1) = 1150 '>65 anys IRPF_MPF(7, 1) = 1400 '>75 anys IRPF_MPF(8, 1) = 3000 'Discapacitat 33%-65% IRPF_MPF(9, 1) = 9000 'Discapacitat >65% IRPF_MPF(10, 1) = 2800 'Fills menors 3 anys IRPF_MPF(11, 1) = 3000 'Assistència discapacitats IRPF_MPF(12, 1) = 1150 'Ascendent >65 anys IRPF_MPF(13, 1) = 1400 'Ascendent >75 anys For i1 = 1 To UBound(IRPF_MPF, 1) IRPF_MPF(i1, 2) = IRPF_MPF(i1, 1) Next i1 ReDim IRPF_RED_RTC(1 To 2) 'Reducció tributació conjunta IRPF_RED_RTC(1) = 3400 'cònjuge IRPF_RED_RTC(2) = 2150 'separació ReDim IRPF_DD_RT(1 To 4) 'Despeses deduïbles rendiments treball IRPF_DD_RT(1) = 2000 'General IRPF_DD_RT(2) = 2000 'Aturats IRPF_DD_RT(3) = 3500 'Discapacitats 33-65% IRPF_DD_RT(4) = 7750 'Discapacitats 65% ReDim IRPF_RED_RT(1 To 2, 1 To 4) 'Reduccions rendiments treball IRPF_RED_RT(1, 2) = 11250 IRPF_RED_RT(1, 3) = 3700 IRPF_RED_RT(2, 2) = 14450 IRPF_RED_RT(2, 3) = 3700 IRPF_RED_RT(2, 4) = 1.15625 ReDim IRPF_RED_PP(1 To 4) 'Reduccions Plans Pensions IRPF_RED_PP(1) = 8000 'general IRPF_RED_PP(2) = 2500 'cònjuge IRPF_RED_PP(3) = 24250 'discapacitats IRPF_RED_PP(4) = 24250 'esportistes professionals IRPF_NTRAMSG(1) = 5 'Trams tarifa general ESTAT IRPF_NTRAMSG(2) = 6 'Trams tarifa general Catalunya auxg = Application.Max(IRPF_NTRAMSG(1), IRPF_NTRAMSG(2)) + 1 ReDim IRPF_TRAMSG(1 To auxg - IIf(auxg = 1, 0, 1), 1 To 2), IRPF_TIPUSG(1 To auxg, 1 To 2) IRPF_TRAMSG(1, 1) = 12450: IRPF_TIPUSG(1, 1) = 0.095: IRPF_TRAMSG(1, 2) = 12450: IRPF_TIPUSG(1, 2) = 0.095 IRPF_TRAMSG(2, 1) = 20200: IRPF_TIPUSG(2, 1) = 0.12: IRPF_TRAMSG(2, 2) = 17707: IRPF_TIPUSG(2, 2) = 0.12 IRPF_TRAMSG(3, 1) = 35200: IRPF_TIPUSG(3, 1) = 0.15: IRPF_TRAMSG(3, 2) = 33007: IRPF_TIPUSG(3, 2) = 0.14 IRPF_TRAMSG(4, 1) = 60000: IRPF_TIPUSG(4, 1) = 0.185: IRPF_TRAMSG(4, 2) = 53407: IRPF_TIPUSG(4, 2) = 0.185 IRPF_TIPUSG(5, 1) = 0.225: IRPF_TRAMSG(5, 2) = 90000: IRPF_TIPUSG(5, 2) = 0.235 IRPF_TIPUSG(6, 2) = 0.24 IRPF_NTRAMSE = 3: 'Trams tarifa estalvi ESTAT ReDim IRPF_TRAMSE(1 To IRPF_NTRAMSE - IIf(IRPF_NTRAMSE = 1, 0, 1)), IRPF_TIPUSE(1 To IRPF_NTRAMSE, 1 To 2) IRPF_TRAMSE(1) = 6000: IRPF_TIPUSE(1, 1) = 0.095: IRPF_TIPUSE(1, 2) = 0.095 IRPF_TRAMSE(2) = 50000: IRPF_TIPUSE(2, 1) = 0.105: IRPF_TIPUSE(2, 2) = 0.105 IRPF_TIPUSE(3, 1) = 0.115: IRPF_TIPUSE(3, 2) = 0.115 IRPF_EXEMPTE = 0 ReDim IRPF_DA(1 To 22, 1 To 6) 'Deduccions IRPF_DA(1, 1) = 0.1: IRPF_DA(1, 2) = 150 'Por donaciones con finalidad ecológica IRPF_DA(2, 1) = 0.1: IRPF_DA(2, 2) = 150 'Por donaciones para la rehabilitación o conservación del patrimonio histórico de Canarias IRPF_DA(3, 1) = 0.1 'Por cantidades destinadas por sus titulares a la restauración, rehabilitación o reparación de bienes inmuebles declarados de Interés Cultural IRPF_DA(4, 1) = 1500: IRPF_DA(4, 2) = 1600 'Por gastos de estudios IRPF_DA(5, 1) = 300 'Por trasladar la residencia habitual a otra isla del Archipiélago para realizar una actividad laboral por cuenta ajena o una actividad económica IRPF_DA(6, 1) = 0.01: IRPF_DA(6, 2) = 240: IRPF_DA(6, 3) = 0.02: IRPF_DA(6, 4) = 480: IRPF_DA(6, 5) = 0.03: IRPF_DA(6, 6) = 720 'Por donaciones en metálico a descendientes o adoptados menores de 35 años para la adquisición o rehabilitación de su primera vivienda habitual IRPF_DA(7, 1) = 200: IRPF_DA(7, 2) = 400: IRPF_DA(7, 3) = 600: IRPF_DA(7, 4) = 700: IRPF_DA(7, 5) = 400: IRPF_DA(7, 6) = 800 'Por nacimiento o adopción de hijos IRPF_DA(8, 1) = 120: IRPF_DA(8, 2) = 300 'Por contribuyentes con discapacidad y mayores de 65 años IRPF_DA(9, 1) = 0.15: IRPF_DA(9, 2) = 400 'Por gastos de guardería IRPF_DA(10, 1) = 200: IRPF_DA(10, 2) = 400: IRPF_DA(10, 3) = 500: IRPF_DA(10, 4) = 1000 'Por familia numerosa IRPF_DA(11, 1) = 0.0175: IRPF_DA(11, 2) = 0.0155 'Por inversión en vivienda habitual IRPF_DA(12, 1) = 0.1 'Por obras de adecuación de la vivienda habitual por razón de discapacidad IRPF_DA(13, 1) = 0.15: IRPF_DA(13, 2) = 500 'Por alquiler de vivienda habitual IRPF_DA(14, 1) = 100 'Por contribuyentes desempleados IRPF_DA(15, 1) = 0.15: IRPF_DA(15, 2) = 0.15 'Por donaciones y aportaciones para fines culturales, deportivos, investigación o docencia IRPF_DA(16, 1) = 0.375: IRPF_DA(16, 2) = 0.15: IRPF_DA(16, 3) = 0.175 'Por donaciones a entidades sin ánimo de lucro y con finalidad ecológica IRPF_DA(17, 1) = 500 'Por gastos de estudios en educación infantil, primaria, enseñanza secundaria obligatoria, bachillerato y formación profesional de grado medio IRPF_DA(18, 1) = 250 'Por acogimiento de menores IRPF_DA(19, 1) = 100 'Por familias monoparentales IRPF_DA(20, 1) = 0.1: IRPF_DA(20, 2) = 7000 'Por obras de rehabilitación energética y reforma de la vivienda habitual IRPF_DA(21, 1) = 0.1: IRPF_DA(21, 2) = 500: IRPF_DA(21, 3) = 700: IRPF_DA(21, 4) = 100 'Por gasto de enfermedad IRPF_DA(22, 1) = 500 'Por familiares dependientes con discapacidad ElseIf tipus_impost = "IS" Then IS_ANYREF = 2016 ReDim IS_R301(1 To 7, 1 To 3) 'Reducció parentiu IS_R301(1, 1) = 100000 'Grup I IS_R301(1, 2) = 12000 'Grup I (increment per edat) IS_R301(1, 3) = 196000 'Grup I (límit) IS_R301(2, 1) = 100000 'Grup II (cònjuge) IS_R301(3, 1) = 100000 'Grup II (fills i adoptats) IS_R301(4, 1) = 50000 'Grup II (resta descendents) IS_R301(5, 1) = 30000 'Grup II (ascendents i adoptants) IS_R301(6, 1) = 8000 'Grup III IS_R301(7, 1) = 50000 'Grupm IV (convivència mútua) ReDim IS_R302(1 To 2) 'Reducció minusvalidesa IS_R302(1) = 275000: IS_R302(2) = 650000 ReDim IS_R303(1 To 2) 'Reducció edat IS_R303(1) = 75: IS_R303(2) = 275000 ReDim IS_R305(1 To 2) 'Reducció assegurances sobre la vida IS_R305(1) = 1: IS_R305(2) = 25000 ReDim IS_R306(1 To 1) 'Reducció empresa individual o negoci professional IS_R306(1) = 0.95 ReDim IS_R307(1 To 3) 'Reducció participacions: entitats, societats laborals, vincle laboral IS_R307(1) = 0.95: IS_R307(2) = 0.97: IS_R307(3) = 0.95 ReDim IS_R308(1 To 2) 'Reducció habitatge IS_R308(1) = 0.95: IS_R308(2) = 500000 ReDim IS_R309(1 To 1) 'Reducció finques rústiques de dedicació forestal IS_R309(1) = 0.95 ReDim IS_R310(1 To 6) 'Reducció explotacions agràries IS_R310(1) = 1: IS_R310(2) = 0.9: IS_R310(3) = 0.85: IS_R310(4) = 0.75: IS_R310(5) = 0.5: IS_R310(6) = 0.95 ReDim IS_R311(1 To 1) 'Reducció béns de patrimoni cultural IS_R311(1) = 0.95 ReDim IS_R312(1 To 2) 'Reducció béns de patrimoni natural i altres IS_R312(1) = 0.95: IS_R312(2) = 0.95 ReDim IS_COEF(1 To 4, 1 To 4) For i1 = 1 To 4 IS_COEF(1, i1) = 1 IS_COEF(2, i1) = 1 IS_COEF(3, i1) = 1.5882 IS_COEF(4, i1) = 2 Next i1 IS_NTRAMS = 5 'Trams i tarifa ReDim IS_TRAMS(1 To IS_NTRAMS - IIf(IS_NTRAMS = 1, 0, 1)), IS_TIPUS(1 To IS_NTRAMS) IS_TRAMS(1) = 50000: IS_TIPUS(1) = 0.07 IS_TRAMS(2) = 150000: IS_TIPUS(2) = 0.11 IS_TRAMS(3) = 400000: IS_TIPUS(3) = 0.17 IS_TRAMS(4) = 800000: IS_TIPUS(4) = 0.24 IS_TIPUS(5) = 0.32 IS_NTRAMS_BON = 11 'Trams i tarifa ReDim IS_BON(11, 1 To 2) 'BONIFICACIONS IS_BON(0, 1) = 0: IS_BON(0, 2) = 0.99 'cònjuge IS_BON(1, 1) = 100000: IS_BON(1, 2) = 0.99 IS_BON(2, 1) = 200000: IS_BON(2, 2) = 0.97 IS_BON(3, 1) = 300000: IS_BON(3, 2) = 0.95 IS_BON(4, 1) = 500000: IS_BON(4, 2) = 0.9 IS_BON(5, 1) = 750000: IS_BON(5, 2) = 0.8 IS_BON(6, 1) = 1000000: IS_BON(6, 2) = 0.7 IS_BON(7, 1) = 1500000: IS_BON(7, 2) = 0.6 IS_BON(8, 1) = 2000000: IS_BON(8, 2) = 0.5 IS_BON(9, 1) = 2500000: IS_BON(9, 2) = 0.4 IS_BON(10, 1) = 3000000: IS_BON(10, 2) = 0.25 IS_BON(11, 2) = 0.2 ElseIf tipus_impost = "ID" Then ID_ANYREF = 2016 ReDim ID_R_BASE(1 To 15, 1 To 3) 'Reduccions a la base ID_R_BASE(1, 1) = 0.95 'Empresa individual o negoci professional (AR) ID_R_BASE(2, 1) = 0.95 'Participacions en entitats (PR) ID_R_BASE(3, 1) = 0.97 'Participacions en societats laborals (LR) ID_R_BASE(4, 1) = 0.95 'Participacions en entitats amb vincle laboral (VR) ID_R_BASE(5, 1) = 0.95 'Quantitats adquisició empresa o participacions (NR) ID_R_BASE(5, 2) = 125000 'Límit general (NR) ID_R_BASE(5, 3) = 250000 'Límit discapacitats (NR) ID_R_BASE(6, 1) = 0.95 'Patrimoni històric o cultural (HR) ID_R_BASE(7, 1) = 0.95 'Immoble destinat habitatge habitual (HB) ID_R_BASE(7, 2) = 60000 'Límit general (HB) ID_R_BASE(7, 3) = 120000 'Límit discapacitats (HB) ID_R_BASE(8, 1) = 0.95 'Quantitats adquisició habitatge habitual (DB) ID_R_BASE(8, 2) = 60000 'Límit general (DB) ID_R_BASE(8, 3) = 120000 'Límit discapacitats (DB) ID_R_BASE(9, 1) = 0.9 'Aportacions patrimonis protegits (MR) ID_R_BASE(10, 1) = 1 'Explotacions agràries (EA) ID_R_BASE(11, 1) = 0.9 'Explotacions agràries (EB) ID_R_BASE(12, 1) = 0.85 'Explotacions agràries (EC) ID_R_BASE(13, 1) = 0.75 'Explotacions agràries (ED) ID_R_BASE(14, 1) = 0.5 'Explotacions agràries (EF) ID_R_BASE(15, 1) = 0.95 'Altres (RR) ID_NTRAMS12 = 3 'Trams i tarifa grups parentiu 1 i 2 ReDim ID_TRAMS12(1 To ID_NTRAMS12 - IIf(ID_NTRAMS12 = 1, 0, 1)), ID_TIPUS12(1 To ID_NTRAMS12) ID_TRAMS12(1) = 200000: ID_TIPUS12(1) = 0.05 ID_TRAMS12(2) = 600000: ID_TIPUS12(2) = 0.07 ID_TIPUS12(3) = 0.09 ID_NTRAMS34 = 5 'Trams i tarifa grups parentiu 3 i 4 ReDim ID_TRAMS34(1 To ID_NTRAMS34 - IIf(ID_NTRAMS34 = 1, 0, 1)), ID_TIPUS34(1 To ID_NTRAMS34) ID_TRAMS34(1) = 50000: ID_TIPUS34(1) = 0.07 ID_TRAMS34(2) = 150000: ID_TIPUS34(2) = 0.11 ID_TRAMS34(3) = 400000: ID_TIPUS34(3) = 0.17 ID_TRAMS34(4) = 800000: ID_TIPUS34(4) = 0.24 ID_TIPUS34(5) = 0.32 ReDim ID_COEF(1 To 4, 1 To 4) For i1 = 1 To 4 ID_COEF(1, i1) = 1 ID_COEF(2, i1) = 1 ID_COEF(3, i1) = 1.5882 ID_COEF(4, i1) = 2 Next i1 ElseIf tipus_impost = "IT" Then IT_ANYREF = 2017 ReDim IT_TIPUS_TPO(1 To 17), IT_TARIFA_TPO(17) IT_NTRAMSTUB = 2 'Trams Tarifes TUB,TRT i TV0 ReDim IT_TRAMSTUB(1 To IT_NTRAMSTUB - IIf(IT_NTRAMSTUB = 1, 0, 1)), IT_TIPUSTUB(1 To IT_NTRAMSTUB) IT_TRAMSTUB(1) = 1000000: IT_TIPUSTUB(1) = 0.1 IT_TIPUSTUB(2) = 0.11 IT_TARIFA_TPO(1) = "TUB" IT_TARIFA_TPO(2) = "TRT" IT_TARIFA_TPO(3) = "TV0" IT_TIPUS_TPO(4) = 0.1: IT_TARIFA_TPO(4) = "TAM" IT_TIPUS_TPO(5) = 0.07: IT_TARIFA_TPO(5) = "THP" IT_TIPUS_TPO(6) = 0.05: IT_TARIFA_TPO(6) = "TUF" IT_TIPUS_TPO(7) = 0.05: IT_TARIFA_TPO(7) = "TUJ" IT_TIPUS_TPO(8) = 0.05: IT_TARIFA_TPO(8) = "TUM" IT_TIPUS_TPO(9) = 0.05: IT_TARIFA_TPO(9) = "TMV" IT_TIPUS_TPO(10) = 0.05: IT_TARIFA_TPO(10) = "TAU" IT_TIPUS_TPO(11) = 0.01: IT_TARIFA_TPO(11) = "DRG" IT_TIPUS_TPO(12) = 0.01: IT_TARIFA_TPO(12) = "PFC" IT_TIPUS_TPO(13) = 0.005: IT_TARIFA_TPO(13) = "AUR" IT_TIPUS_TPO(14) = 0.04: IT_TARIFA_TPO(14) = "CEB" IT_TIPUS_TPO(15) = 0.04: IT_TARIFA_TPO(15) = "CEO" IT_TIPUS_TPO(16) = 0.04: IT_TARIFA_TPO(16) = "CES" IT_TIPUS_TPO(17) = 0.04: IT_TARIFA_TPO(17) = "ANE" IT_BON_TUB = 0.7 'Bonificació tarifa TUB ReDim IT_TIPUS_OS(1 To 7), IT_TARIFA_OS(1 To 7) IT_TIPUS_OS(1) = 0.01: IT_TARIFA_OS(1) = "OSC" IT_TIPUS_OS(2) = 0.01: IT_TARIFA_OS(2) = "OSA" IT_TIPUS_OS(3) = 0.01: IT_TARIFA_OS(3) = "OSS" IT_TIPUS_OS(4) = 0.01: IT_TARIFA_OS(4) = "OST" IT_TIPUS_OS(5) = 0.01: IT_TARIFA_OS(5) = "OSR" IT_TIPUS_OS(6) = 0.01: IT_TARIFA_OS(6) = "OSV" IT_TIPUS_OS(7) = 0.01: IT_TARIFA_OS(7) = "OSF" ReDim IT_TIPUS_AJD(1 To 17), IT_TARIFA_AJD(1 To 17) IT_TIPUS_AJD(1) = 0.015: IT_TARIFA_AJD(1) = "AJ0" IT_TIPUS_AJD(2) = 0.015: IT_TARIFA_AJD(2) = "AJ1" IT_TIPUS_AJD(3) = 0.015: IT_TARIFA_AJD(3) = "AJ2" IT_TIPUS_AJD(4) = 0.015: IT_TARIFA_AJD(4) = "AJ3" IT_TIPUS_AJD(5) = 0.015: IT_TARIFA_AJD(5) = "AJ4" IT_TIPUS_AJD(6) = 0.025: IT_TARIFA_AJD(6) = "AJ5" IT_TIPUS_AJD(7) = 0.015: IT_TARIFA_AJD(7) = "AJ6" IT_TIPUS_AJD(8) = 0.015: IT_TARIFA_AJD(8) = "AJ7" IT_TIPUS_AJD(9) = 0.015: IT_TARIFA_AJD(9) = "AJ8" IT_TIPUS_AJD(10) = 0.001: IT_TARIFA_AJD(10) = "AJ9" IT_TIPUS_AJD(11) = 0.001: IT_TARIFA_AJD(11) = "AAH" IT_TIPUS_AJD(12) = 0.001: IT_TARIFA_AJD(12) = "APH" IT_TIPUS_AJD(13) = 0.005: IT_TARIFA_AJD(13) = "AP0" IT_TIPUS_AJD(14) = 0.005: IT_TARIFA_AJD(14) = "AJJ" IT_TIPUS_AJD(15) = 0.005: IT_TARIFA_AJD(15) = "AJM" IT_TIPUS_AJD(16) = 0.015: IT_TARIFA_AJD(16) = "AIC" IT_TIPUS_AJD(17) = 0.015: IT_TARIFA_AJD(17) = "AIM" ElseIf tipus_impost = "IPPF" Then IPPF_ANYREF = 2017 IPPF_OP(1) = 500000: IPPF_OP(2) = 0 'Reducció Obligació personal general i discapacitats IPPF_LIM(1) = 0.6: IPPF_LIM(2) = 0.8 'Limit QI IRPF i QI IPPF ReDim LVAR(1 To 22) As String 'Definició dels béns LVAR(1) = "Béns immobles de naturalesa urbana" LVAR(2) = "Béns immobles de naturalesa rústica" LVAR(3) = "Béns i drets no exempts afectes a activitats empresarials i professionals" LVAR(4) = "Béns i drets exempts afectes a activitats empresarials i professionals" LVAR(5) = "Dipòsits en compte corrent o d'estalvi, a la vista o a termini, comptes financers i altres tipus d'imposicions en compte" LVAR(6) = "Deute públic, obligacions bons, i altres valors equivalents, negociats en mercats organitzats" LVAR(7) = "Obligacions, bons, certificats de dipòsit, pagarés, i altres valors equivalents, no negociats en mercats organitzats" LVAR(8) = "Accions i participacions en el capital social o en el fons patrimonial d'institucions d'inversió col·lectiva (societats i fons d'inversió), negociades en mercats organitzats" LVAR(9) = "Accions i participacions en el capital social o en els fons propis de qualsevol altres entitas jurídiques, negociades en mercats organitzats" LVAR(10) = "Accions i participacions en el capital social o en el fons patrimonial d'institucions d'inversió col·lectiva (societats i fons d'inversió), no negociades en mercats organitzats" LVAR(11) = "Accions i participacions en el capital social o en els fons propis de qualsevol altres entitas jurídiques, no negociades en mercats organitzats, incloses les participacions en el capital social de cooperatives" LVAR(12) = "Accions i participacions exemptes en el capital social o en els fons propis d'entitas jurídiques, negociades en mercats organitzats" LVAR(13) = "Accions i participacions exemptes en el capital social o en els fons propis d'entitas jurídiques, no negociades en mercats organitzats, incloses les participacions exemptes en el capital social de cooperatives" LVAR(14) = "Assegurances de vida" LVAR(15) = "Rendes temporals i vitalícies" LVAR(16) = "Vehicles, joies, pells de caràcter sumptuari, embarcacions i aeronaus" LVAR(17) = "Objectes d'art i antiguitats" LVAR(18) = "Drets reals d'ús i gaudi (excepte els que corresponguin, si s'escau, a l'habitatge habitual del subjecte passiu)" LVAR(19) = "Concessions administratives" LVAR(20) = "Drets derivats de la propietat intel.lectual i industrial" LVAR(21) = "Opcions contractuals" LVAR(22) = "Altres béns i drets de contingut econòmic" ReDim IPPF_E(1 To 22) 'Béns exempts=0 o no exempts=1 For i1 = 1 To 22 If i1 = 4 Or i1 = 12 Or i1 = 13 Then IPPF_E(i1) = 1 Else IPPF_E(i1) = 0 Next i1 ReDim IPPF_ME(1 To 22) 'Mínims exempts béns IPPF_ME(1) = 300000 'Habitatge habitual For i1 = 2 To 22 IPPF_ME(i1) = 0 'Resta de béns Next i1 IPPF_NTRAMS = 8 'Trams i tipus ReDim IPPF_TRAMS(1 To IPPF_NTRAMS - 1), IPPF_TIPUS(1 To IPPF_NTRAMS) IPPF_TRAMS(1) = 167130: IPPF_TIPUS(1) = 0.0021 IPPF_TRAMS(2) = 334253: IPPF_TIPUS(2) = 0.00315 IPPF_TRAMS(3) = 668500: IPPF_TIPUS(3) = 0.00525 IPPF_TRAMS(4) = 1337000: IPPF_TIPUS(4) = 0.00945 IPPF_TRAMS(5) = 2673999: IPPF_TIPUS(5) = 0.01365 IPPF_TRAMS(6) = 5347998: IPPF_TIPUS(6) = 0.01785 IPPF_TRAMS(7) = 10695996: IPPF_TIPUS(7) = 0.02205 IPPF_TIPUS(8) = 0.0275 End If End Sub Sub COMUNS_1REFERENCIA_SIMULS(opcio As String, nsim, p) Dim i As Integer, j As Integer, nom As String If opcio = "IRPF" Then nom = NOM_IRPF_SIMUL & "S" & ANOIRPF & "_" & Trim(Str(nsim)) & ".xlsx" If opcio = "IS" Then nom = NOM_IS_SIMUL & "S" & ANOIS & "_" & Trim(Str(nsim)) & ".xlsx" If opcio = "ID" Then nom = NOM_ID_SIMUL & "S" & ANOID & "_" & Trim(Str(nsim)) & ".xlsx" If opcio = "IT" Then nom = NOM_IT_SIMUL & "S" & ANOIT & "_" & Trim(Str(nsim)) & ".xlsx" If opcio = "IPPF" Then nom = NOM_IPPF_SIMUL & "S" & ANOIPPF & "_" & Trim(Str(nsim)) & ".xlsx" Application.ScreenUpdating = False Set LLIBRE_RESULTATS = Workbooks.Open(nom) Workbooks(Workbooks.Count).Activate Sheets("PARAMETRES").Activate For i = 0 To UBound(p, 1) For j = 1 To UBound(p, 2) p(i, j) = Cells(i + 1, j) Next j Next i LLIBRE_RESULTATS.Close Application.ScreenUpdating = True End Sub Sub COMUNS_2ORDENA(opcio As String) Dim i1 As Long, it As Integer ReDim y(1 To N) If opcio = "IRPF" Then For it = 2 To 3 'ordenació 1=RTC (com està ordenat) / ordenació 2=BIT / ordenació 3=BLT For i1 = 1 To N y(i1) = X(i1, it) IND(i1, it) = i1 Next i1 Call COMUNS_2ORDENA_AUX(1, N, it) 'Crida a la rutina per a ordenar Next it ElseIf opcio = "IS" Then For it = 1 To 2 'ord. 1==>BI 2==>BL For i1 = 1 To N y(i1) = X(i1, IIf(it = 1, 1, 6)) IND(i1, it) = i1 Next i1 Call COMUNS_2ORDENA_AUX(1, N, it) 'Crida a la rutina per a ordenar Next it ElseIf opcio = "ID" Then For it = 1 To 2 'ord. 1==>BI 2==>BL For i1 = 1 To N y(i1) = X(i1, IIf(it = 1, 1, 3)) IND(i1, it) = i1 Next i1 Call COMUNS_2ORDENA_AUX(1, N, it) 'Crida a la rutina per a ordenar Next it ' Dim it1 As Integer, k1 As Integer, d As Integer, v As Integer ' d = (UBound(X, 2) / 3) ' For it = 1 To 2 'ord. 1==>BI 2==>BL ' For k1 = 1 To 3 ' it1 = it + 2 * (k1 - 1) ' v = it + d * (k1 - 1) ' For i1 = 1 To N ' y(i1) = X(i1, v) ' IND(i1, it1) = i1 ' Next i1 ' Call COMUNS_2ORDENA_AUX(1, N, it1) 'Crida a la rutina per a ordenar ' Next k1 ' Next it ElseIf opcio = "IT" Then Dim i2 As Long, i3 As Long, k1 As Integer For k1 = 1 To 3 'k1=1 ==>TPO k1=2 ==>OS k1=3 ==>AJD i2 = IIf(k1 = 1, 1, IIf(k1 = 2, N1 + 1, N1 + N2 + 1)) i3 = IIf(k1 = 1, N1, IIf(k1 = 2, N1 + N2, N1 + N2 + N3)) For i1 = i2 To i3 y(i1) = X(i1, 1) IND(i1, 1) = i1 Next i1 Call COMUNS_2ORDENA_AUX(i2, i3, 1) 'Crida a la rutina per a ordenar Next k1 ElseIf opcio = "IPPF" Then For it = 0 To 2 'ord. 0==> PE+PNE 1==>BI ord.2==>BL For i1 = 1 To N y(i1) = X(i1, it) IND(i1, it) = i1 Next i1 Call COMUNS_2ORDENA_AUX(1, N, it) 'Crida a la rutina per a ordenar Next it End If End Sub Sub COMUNS_2ORDENA_AUX(lim_i As Long, lim_s As Long, columna As Integer) Dim i As Long, j As Long, aux As Double, y1 As Double, ind1 As Long i = lim_i j = lim_s aux = y((lim_i + lim_s) / 2) While i <= j While (y(i) < aux) And (i < lim_s) i = i + 1 Wend While (aux < y(j)) And (j > lim_i) j = j - 1 Wend If i <= j Then y1 = y(i) y(i) = y(j) y(j) = y1 ind1 = IND(i, columna) IND(i, columna) = IND(j, columna) IND(j, columna) = ind1 i = i + 1 j = j - 1 End If Wend If lim_i < j Then COMUNS_2ORDENA_AUX lim_i, j, columna If i < lim_s Then COMUNS_2ORDENA_AUX i, lim_s, columna End Sub Sub COMUNS_3ESCRIPTURA_AUXILIAR(arxiu As String) Dim i1 As Integer, i2 As Long, j1 As Integer, nom As String '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Crea els arxius per a guardar els resultats de la simulació '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If arxiu = "IRPF" Then PARMS(0, 1) = "N" '*******************ULL**********************' PARMS(0, 2) = "NT" PARMS(0, 25) = "PAG(1)" PARMS(0, 26) = "PAG(2)" PARMS(0, 27) = "PAG(3)" nom = NOM_IRPF_SIMUL & "S" & ANOIRPF & "_" & Trim(Str(CIRPF(ISIMULS(1)) + 1)) & ".xlsx" FileCopy ThisWorkbook.Path & "\SIMUL\IRPF\PLANTILLA_IRPF.xlsx", nom Set LLIBRE_RESULTATS = Workbooks.Open(nom) Workbooks(Workbooks.Count).Activate ActiveWorkbook.Unprotect (SECRET) Sheets("PARAMETRES").Activate For i1 = 0 To UBound(PARMS, 1) For j1 = 1 To UBound(PARMS, 2) Cells(i1 + 1, j1) = PARMS(i1, j1) Next j1 Next i1 Cells(1, 1).Select ActiveSheet.Protect (SECRET) GoTo SALTA '*******************ULL**********************' Sheets("DESCRIPTIU").Activate For i1 = 1 To 28 For j1 = 1 To 8 Cells(i1, j1) = VT(i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Cells(1, 1).Select Sheets("LIMITS-MITJANES").Activate For i1 = 1 To 4 For j1 = 1 To 12 Cells(i1, j1) = VT(28 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Cells(1, 1).Select Sheets("G-P").Activate For i1 = 1 To 6 For j1 = 1 To 12 Cells(i1, j1) = VT(32 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Cells(1, 1).Select Sheets("DECILS-RTC").Activate For i1 = 1 To 56 For j1 = 1 To 12 Cells(i1, j1) = VT(38 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("TIPUS-RTC").Activate For i1 = 1 To 24 For j1 = 1 To 12 Cells(i1, j1) = VT(94 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Cells(1, 1).Select Sheets("DECILS-BIT").Activate For i1 = 1 To 56 For j1 = 1 To 12 Cells(i1, j1) = VT(118 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Cells(1, 1).Select Sheets("TIPUS-BIT").Activate For i1 = 1 To 24 For j1 = 1 To 12 Cells(i1, j1) = VT(174 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Cells(1, 1).Select Sheets("INDEXS").Activate For i1 = 1 To 79 For j1 = 1 To 3 Cells(i1, j1) = VT(198 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("SOCIO-ECONOMICA").Activate For i1 = 1 To 72 For j1 = 1 To 11 Cells(i1, j1) = VT(277 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Cells(1, 1).Select Open NOM_IRPF_SIMUL & "GP" & ANOIRPF & "_" & Trim(Str(CIRPF(ISIMULS(1)) + 1)) & ".dat" For Output As #1 Write #1, N, DECL_NOMBRE, ANY_PROJ Write #1, "ID", "RTC", "BIT", "BLT", "QLA", "RD", "pes", "ordre-BIT" For i2 = 1 To N Write #1, IDENTIFICADOR(i2), X(i2, 1), X(i2, 2), X(i2, 3), X(i2, 23), X(i2, 28), X(i2, 29), IND(i2, 2) Next i2 Close #1 SALTA: '*******************ULL**********************' ElseIf arxiu = "IS" Then PARMS(0, 5) = N1 PARMS(0, 6) = NT1 PARMS(0, 7) = N2 PARMS(0, 8) = NT2 PARMS(0, 9) = N PARMS(0, 10) = NT nom = NOM_IS_SIMUL & "S" & ANOIS & "_" & Trim(Str(CIS(ISIMULS(2)) + 1)) & ".xlsx" FileCopy ThisWorkbook.Path & "\SIMUL\IS\PLANTILLA_IS.xlsx", nom Set LLIBRE_RESULTATS = Workbooks.Open(nom) Workbooks(Workbooks.Count).Activate Sheets("PARAMETRES").Activate For i1 = 0 To UBound(PARMS, 1) For j1 = 1 To UBound(PARMS, 2) Cells(i1 + 1, j1) = PARMS(i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("DESCRIPTIU").Activate For i1 = 1 To 34 For j1 = 1 To 12 Cells(i1, j1) = VT(i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("LIMITS-MITJANES").Activate For i1 = 1 To 6 For j1 = 1 To 12 Cells(i1, j1) = VT(34 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("DECILS-TIPUS").Activate For i1 = 1 To 66 For j1 = 1 To 12 Cells(i1, j1) = VT(40 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("INDEXS").Activate For i1 = 1 To 26 For j1 = 1 To 8 Cells(i1, j1) = VT(106 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Open NOM_IS_SIMUL & "GP" & ANOIS & "_" & Trim(Str(CIS(ISIMULS(2)) + 1)) & ".dat" For Output As #1 Write #1, N1, N2, N, NT1, NT2, NT Write #1, "ID", "GP", "BI", "BL", "QT" For i2 = 1 To N Write #1, IDENTIFICADOR(IND(i2, 1), 1), IDENTIFICADOR(IND(i2, 1), 2), X(IND(i2, 1), 1), X(IND(i2, 1), 6), X(IND(i2, 1), 10) Next i2 Close #1 ElseIf arxiu = "ID" Then nom = NOM_ID_SIMUL & "S" & ANOID & "_" & Trim(Str(CID(ISIMULS(3)) + 1)) & ".xlsx" FileCopy ThisWorkbook.Path & "\SIMUL\ISD\PLANTILLA_ID.xlsx", nom Set LLIBRE_RESULTATS = Workbooks.Open(nom) Workbooks(Workbooks.Count).Activate ActiveWorkbook.Unprotect (SECRET) Sheets("PARAMETRES").Activate For i1 = 0 To UBound(PARMS, 1) For j1 = 1 To UBound(PARMS, 2) Cells(i1 + 1, j1) = PARMS(i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("DESCRIPTIU").Activate For i1 = 1 To 18 For j1 = 1 To 12 Cells(i1, j1) = VT(i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("LIMITS-MITJANES").Activate For i1 = 1 To 6 For j1 = 1 To 12 Cells(i1, j1) = VT(18 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("DECILS-TIPUS").Activate For i1 = 1 To 36 For j1 = 1 To 12 Cells(i1, j1) = VT(24 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("INDEXS").Activate For i1 = 1 To 42 For j1 = 1 To 2 Cells(i1, j1) = VT(60 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Open NOM_ID_SIMUL & "GP" & ANOID & "_" & Trim(Str(CID(ISIMULS(3)) + 1)) & ".dat" For Output As #1 Write #1, N1, N2, N, NT1, NT2, NT Write #1, "ID", "GP", "BI", "BL", "QT" For i2 = 1 To N Write #1, IDENTIFICADOR(IND(i2, 1), 1), IDENTIFICADOR(IND(i2, 1), 2), X(IND(i2, 1), 1), X(IND(i2, 1), 3), X(IND(i2, 1), 5) Next i2 Close #1 ElseIf arxiu = "IT" Then nom = NOM_IT_SIMUL & "S" & ANOIT & "_" & Trim(Str(CIT(ISIMULS(4)) + 1)) & ".xlsx" FileCopy ThisWorkbook.Path & "\SIMUL\ITPOAJDOS\PLANTILLA_IT.xlsx", nom Set LLIBRE_RESULTATS = Workbooks.Open(nom) Workbooks(Workbooks.Count).Activate ActiveWorkbook.Unprotect (SECRET) LLIBRE_RESULTATS.Protect (SECRET) Sheets("PARAMETRES").Activate For i1 = 0 To UBound(PARMS, 1) For j1 = 1 To UBound(PARMS, 2) Cells(i1 + 1, j1) = PARMS(i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("DESCRIPTIU").Activate For i1 = 1 To 44 For j1 = 1 To 10 Cells(i1, j1) = VT(i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("INDEXS").Activate For i1 = 1 To 12 For j1 = 1 To 1 Cells(i1, j1) = VT(44 + i1, 1) Next j1 Next i1 ActiveSheet.Protect (SECRET) ElseIf arxiu = "IPPF" Then PARMS(0, 4) = N PARMS(0, 5) = PAG(1) PARMS(0, 6) = PAG(2) PARMS(0, 7) = PAG(3) nom = NOM_IPPF_SIMUL & "S" & ANOIPPF & "_" & Trim(Str(CIPPF(ISIMULS(5)) + 1)) & ".xlsx" FileCopy ThisWorkbook.Path & "\SIMUL\IPPF\PLANTILLA_IPPF.xlsx", nom Set LLIBRE_RESULTATS = Workbooks.Open(nom) Workbooks(Workbooks.Count).Activate ActiveWorkbook.Unprotect (SECRET) Sheets("PARAMETRES").Activate For i1 = 0 To UBound(PARMS, 1) For j1 = 1 To UBound(PARMS, 2) Cells(i1 + 1, j1) = PARMS(i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("DESCRIPTIU").Activate For i1 = 1 To 4 For j1 = 1 To 8 Cells(i1, j1) = VT(i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("LIMITS-MITJANES").Activate For i1 = 1 To 2 For j1 = 1 To 12 Cells(i1, j1) = VT(4 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("DECILS-TIPUS").Activate For i1 = 1 To 10 For j1 = 1 To 12 Cells(i1, j1) = VT(6 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("INDEXS").Activate For i1 = 1 To 6 For j1 = 1 To 2 Cells(i1, j1) = VT(16 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Sheets("G-P").Activate For i1 = 1 To 6 For j1 = 1 To 12 Cells(i1, j1) = VT(22 + i1, j1) Next j1 Next i1 ActiveSheet.Protect (SECRET) Open NOM_IPPF_SIMUL & "GP" & ANOIPPF & "_" & Trim(Str(CIPPF(ISIMULS(5)) + 1)) & ".dat" For Output As #1 Write #1, N Write #1, "ID", "P", "BI", "BL", "Q(P)", "Ordre-P", "Ordre-BI" For i2 = 1 To N Write #1, SP(i2, 1), X(i2, 0), X(i2, 1), X(i2, 2), X(i2, 3), IND(i2, 0), IND(i2, 1) Next i2 Close #1 End If LLIBRE_RESULTATS.Protect (SECRET) LLIBRE_RESULTATS.Save LLIBRE_RESULTATS.Close End Sub Sub COMUNS_41GRAFICS_CORBESLORENZ(fila, GP, impost_t, nom, r_g, s_r) 'fila ==> línia on escriu el gràfic 'impost_t ==> "IRPF", "IS" o "ID" 'nom ==> nom de les corbes 'r_g ==> rangs dels valors de les sèries dels gràfics 's_r ==> indicador d'igualtat de les corbes Dim i1 As Integer, i2 As Integer For i1 = 1 To 2 Charts.Add With ActiveChart .ChartType = xlXYScatterSmoothNoMarkers For i2 = 1 To IIf(GP, 7, 4) .SeriesCollection.NewSeries With .SeriesCollection(i2) With .Border .ColorIndex = IIf(i2 = 1 Or i2 = 5, 32, IIf(i2 = 2 Or i2 = 6, 3, IIf(i2 = 3 Or i2 = 7, 60, 1))) If i2 > 4 And s_r(i2, i1) Then .LineStyle = xlDot .Weight = xlMedium End With .MarkerStyle = xlNone .Name = nom(i2, i1) If i2 <> 4 Then .Values = r_g(i2, i1) If i2 <> 3 And i2 <> 7 Then .XValues = Array(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 0.95, 0.98, 1) Else .XValues = r_g(i2 - 2, i1) End If Else .Values = Array(0, 1) .XValues = Array(0, 1) End If End With Next i2 For i2 = 1 To 2 With .Axes(IIf(i2 = 1, xlCategory, xlValue)) .HasMajorGridlines = True .HasDisplayUnitLabel = False .MinorUnit = 0.1 .MajorUnit = 0.1 .MinimumScale = 0 .MaximumScale = 1 .TickLabels.Font.Bold = True .TickLabels.Font.Name = "Calibri" .TickLabels.Font.Size = 7 .TickLabels.NumberFormat = "0%" End With Next i2 .HasTitle = True With .ChartTitle .Characters.Text = "Curvas de Lorenz y Concentración (ordenación abcisa " If impost_t = "IRPF" Then .Characters.Text = .Characters.Text & IIf(i1 = 1, "RTC)", "BIT)") If impost_t <> "IRPF" Then .Characters.Text = .Characters.Text & IIf(i1 = 1, "BI)", "BL)") .Font.Bold = True .Font.Name = "Calibri" .Font.Size = 7.5 .Top = 0 End With With .Legend .Border.LineStyle = xlNone .Font.Bold = True .Font.Name = "Calibri" .Font.Size = IIf(GP, 5.5, 7) For i2 = .LegendEntries.Count To IIf(GP, 8, 5) Step -1 .LegendEntries(i2).Delete Next i2 .LegendEntries(4).Delete .Position = xlLegendPositionBottom End With With .PlotArea .Interior.ColorIndex = 2 .Left = 0 .Top = 15 '20 .Width = 805 .Height = IIf(GP, 400, 415) '630, 650 End With .Location Where:=xlLocationAsObject, Name:=impost_t & "(R)" ''''''''''''''''''''''''''''''''''''''''''' 'Definició d'alçada i amplada dels gràfics' ''''''''''''''''''''''''''''''''''''''''''' With Worksheets(impost_t & "(R)") .ChartObjects(1).Height = 218 .ChartObjects(1).Width = 260 End With ''''''''''''''''''''''''''''''''''''' 'Reconversió dels gràfics en imatges' ''''''''''''''''''''''''''''''''''''' ActiveSheet.ChartObjects(1).CopyPicture ActiveWindow.Visible = False Cells(fila, IIf(i1 = 1, 1, 8)).Select ActiveSheet.Paste Worksheets(impost_t & "(R)").ChartObjects(1).Delete End With Next i1 End Sub Sub COMUNS_42GRAFICS_TIPUS(fila, GP, impost_t, mmin, mmax, r_g, s_r, sim) 'fila ==> línia on escriu el gràfic 'impost_t ==> "IRPF", "IS" o "ID" 'mmin ==> valor mínim de l'escala vertical del gràfic 'mmax ==> valor màxim de l'escala vertical del gràfic 'r_g ==> rangs dels valors de les sèries dels gràfics 'sim ==> nombre de la simulació 's_r ==> indicador d'igualtat dels tipus Dim i1 As Integer, i2 As Integer For i1 = 1 To IIf(impost_t = "IRPF", 6, 2) Charts.Add With ActiveChart .ChartType = xlXYScatterSmoothNoMarkers For i2 = 1 To IIf(GP, 2, 1) .SeriesCollection.NewSeries With .SeriesCollection(i2) .Border.ColorIndex = IIf(i2 = 1, 32, IIf(s_r(i1, 3), 40, 32)) .Border.Weight = xlMedium .MarkerStyle = xlNone .Name = IIf(i2 = 1, "Simulación-" & sim, "Referencia") .Values = r_g(i2, i1 + 2) .XValues = Array(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 0.95, 0.98, 1) End With Next i2 For i2 = 1 To 2 With .Axes(IIf(i2 = 1, xlCategory, xlValue)) .HasMajorGridlines = True .HasDisplayUnitLabel = False .MinorUnit = IIf(i2 = 1, 0.1, (-mmin + mmax) / 10) .MajorUnit = IIf(i2 = 1, 0.1, (-mmin + mmax) / 10) .MinimumScale = IIf(i2 = 1, 0.1, IIf(impost_t = "IRPF", mmin, 0)) '0 .MaximumScale = IIf(i2 = 1, 1, mmax) .TickLabels.Font.Bold = True .TickLabels.Font.Name = "Calibri" .TickLabels.Font.Size = 7 .TickLabels.NumberFormat = IIf(i2 = 1, "0%", "0,0%") End With Next i2 .Axes(xlCategory).TickLabelPosition = xlLow .HasTitle = True With .ChartTitle If impost_t = "IRPF" Then If i1 = 1 Then .Characters.Text = "CRA s/RTC (ordenación abcisa RTC)" If i1 = 2 Then .Characters.Text = "CLA s/RTC (ordenación abcisa RTC)" If i1 = 3 Then .Characters.Text = "CRA s/BIT (ordenación abcisa BIT)" If i1 = 4 Then .Characters.Text = "CLA s/BIT (ordenación abcisa BIT)" If i1 = 5 Then .Characters.Text = "CRA s/BLT (ordenación abcisa BIT)" If i1 = 6 Then .Characters.Text = "CLA s/BLT (ordenación abcisa BIT)" Else .Characters.Text = "Tipos efectivos s/Base " & IIf(i1 = 1, "Imponible", "Liquidable") & " (ordenación abcisa BI)" End If .Font.Bold = True .Font.Name = "Calibri" .Font.Size = 8.5 .Top = 0 End With With .Legend .Border.LineStyle = xlNone .Font.Bold = True .Font.Name = "Calibri" .Font.Size = 7 For i2 = .LegendEntries.Count To IIf(GP, 3, 2) Step -1 .LegendEntries(i2).Delete Next i2 .Position = xlLegendPositionBottom End With With .PlotArea .Interior.ColorIndex = 2 .Left = 0 .Top = 15 '20 .Width = 805 .Height = 415 '650 End With .Location Where:=xlLocationAsObject, Name:=impost_t & "(R)" ''''''''''''''''''''''''''''''''''''''''''' 'Definició d'alçada i amplada dels gràfics' ''''''''''''''''''''''''''''''''''''''''''' With Worksheets(impost_t & "(R)") .ChartObjects(1).Height = 218 .ChartObjects(1).Width = 260 End With ''''''''''''''''''''''''''''''''''''' 'Reconversió dels gràfics en imatges' ''''''''''''''''''''''''''''''''''''' ActiveSheet.ChartObjects(1).CopyPicture ActiveWindow.Visible = False If impost_t <> "IRPF" Then Cells(fila, IIf(i1 = 1 Or i1 = 3 Or i1 = 5, 1, 8)).Select Else Cells(IIf(i1 < 3, fila, IIf(i1 < 5, fila + 23, fila + 46)), _ IIf(i1 = 1 Or i1 = 3 Or i1 = 5, 1, 8)).Select End If ActiveSheet.Paste Worksheets(impost_t & "(R)").ChartObjects(1).Delete End With Next i1 End Sub Sub COMUNS_43GRAFICS_GP(fila, iany, impost_t, opcio, r_gp, sim) 'fila ==> línia on escriu el gràfic 'iany ==> ANOIRPF, ANOIS, ANOID, ANOIPPF 'impost_t ==> "IRPF", "IS" , "ID" "IPPF" 'opcio ==> "(R)" o "(GP)" 'r_gp ==> rangs dels valors de les sèries dels gràfics 'sim ==> nombre de la simulació o 1 quan es la comparació de dues simulacions Dim i1 As Integer, i2 As Integer, j1 As Integer, m As Double If opcio = "(R)" And impost_t = "IRPF" Then With Range(Cells(fila - 1, 1), Cells(fila + 45, 15)) .ColumnWidth = 6.43 .Interior.ColorIndex = 2 .RowHeight = 10 End With With Range(Cells(fila - 1, 1), Cells(fila - 1, 1)) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "GRÁFICOS DE LA SIMULACIÓN-" & sim & " (Base de datos: " & iany & ") cont." End With End If For i1 = 1 To 4 If i1 = 1 Then m = Application.Max(r_gp(1, 1), r_gp(2, 1)) For i2 = 100 To 0 Step -10 If m * 100 > i2 Then Exit For Next i2 m = (i2 / 100) + 0.1 End If Charts.Add With ActiveChart .ChartType = IIf(i1 = 1, xlColumnClustered, xlColumnStacked) For j1 = .SeriesCollection.Count To 1 Step -1 .SeriesCollection(j1).Delete Next j1 For i2 = 1 To 2 .SeriesCollection.NewSeries With .SeriesCollection(i2) .Interior.ColorIndex = IIf(i1 = 1, IIf(i2 = 1, 32, 40), IIf(i2 = 1, 1, 3)) If opcio = "(G-P)" Then .Name = IIf(i1 = 1, IIf(i2 = 1, "Simulación-" & COMP(1), "Simulación-" & COMP(2)), _ IIf(i1 = 2, IIf(i2 = 1, "%Ganadores", "%Perdedores"), _ IIf(i2 = 1, "Ganancias", "Pérdidas"))) Else .Name = IIf(i1 = 1, IIf(i2 = 1, "Simulación-" & sim, "Referencia"), _ IIf(i1 = 2, IIf(i2 = 1, "%Ganadores", "%Perdedores"), _ IIf(i2 = 1, "Ganancias", "Pérdidas"))) End If .Values = r_gp(i2, i1) .XValues = Array(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 0.95, 0.98, 1) End With Next i2 For i2 = 1 To 2 With .Axes(IIf(i2 = 1, xlCategory, xlValue)) If i2 = 1 Then .TickLabelSpacing = 1 .TickLabelPosition = xlLow Else .HasDisplayUnitLabel = False If i1 <= 2 Then .MinorUnit = IIf(i1 = 1, m / 10, 0.2) .MajorUnit = IIf(i1 = 1, m / 10, 0.2) .MinimumScale = IIf(i1 = 1, 0, -1) .MaximumScale = IIf(i1 = 1, m, 1) End If End If .TickLabels.Font.Bold = True .TickLabels.Font.Name = "Calibri" .TickLabels.Font.Size = 7 .TickLabels.NumberFormat = IIf(i2 = 1, "0%", IIf(i1 <= 2, "0%", "###.###0")) End With Next i2 .HasTitle = True With .ChartTitle If opcio = "(G-P)" Then If i1 = 1 Then If impost_t = "IRPF" Then .Characters.Text = "Distribución RD" If impost_t = "IPPF" Then .Characters.Text = "Distribución de la CUOTA" If impost_t <> "IRPF" And impost_t <> "IPPF" Then .Characters.Text = "Distribución de la CT" End If If i1 = 2 Then .Characters.Text = "%Ganadores y %Perdedores. Simulación-" & COMP(1) & " vs. Simulación-" & COMP(2) If i1 = 3 Then .Characters.Text = "Ganancias y Pérdidas totales (miles de €). Simulación-" & COMP(1) & " vs. Simulación-" & COMP(2) If i1 = 4 Then .Characters.Text = "Ganancias y Pérdidas per capita(€). Simulación-" & COMP(1) & " vs. Simulación-" & COMP(2) Else If i1 = 1 Then If impost_t = "IRPF" Then .Characters.Text = "Distribución RD (ordenación abcisa RTC)" If impost_t <> "IRPF" Then .Characters.Text = "Distribución de la CT (ordenación abcisa BI)" End If If i1 = 2 Then .Characters.Text = "%Ganadores y %Perdedores. Simulación-" & sim & " vs. Referencia" If i1 = 3 Then .Characters.Text = "Ganancias y Pérdidas totals (milers d'€). Simulación-" & sim & " vs. Referencia" If i1 = 4 Then .Characters.Text = "Ganancias y Pérdidas per capita(€). Simulación-" & sim & " vs. Referencia" End If .Font.Bold = True .Font.Name = "Calibri" .Font.Size = 7 .Top = 0 End With With .Legend .Border.LineStyle = xlNone .Font.Bold = True .Font.Name = "Calibri" .Font.Size = 7 For i2 = .LegendEntries.Count To 3 Step -1 .LegendEntries(i2).Delete Next i2 .Position = xlLegendPositionBottom End With With .PlotArea .Interior.ColorIndex = 2 .Left = 0 .Top = 15 '20 .Width = 805 .Height = 415 '650 End With .Location Where:=xlLocationAsObject, Name:=impost_t & opcio ''''''''''''''''''''''''''''''''''''''''''' 'Definició d'alçada i amplada dels gràfics' ''''''''''''''''''''''''''''''''''''''''''' Dim iheight As Integer, iwidth As Integer With Worksheets(impost_t & opcio) If opcio = "(R)" Then iheight = 218 iwidth = 260 Else iheight = 218 iwidth = 260 End If .ChartObjects(1).Height = iheight .ChartObjects(1).Width = iwidth End With ''''''''''''''''''''''''''''''''''''' 'Reconversió dels gràfics en imatges' ''''''''''''''''''''''''''''''''''''' ActiveSheet.ChartObjects(1).CopyPicture ActiveWindow.Visible = False Cells(IIf(i1 < 3, fila, fila + 23), IIf(i1 = 1 Or i1 = 3, 1, 8)).Select ActiveSheet.Paste Worksheets(impost_t & opcio).ChartObjects(1).Delete End With Next i1 End Sub Sub COMUNS_5IMPRESSIO(impost_t, opcio) '''''''''''''''''''''''''''''''' 'Configura el full de resultats' '''''''''''''''''''''''''''''''' ActiveWindow.View = xlPageBreakPreview With ActiveWindow .DisplayWorkbookTabs = True .View = xlNormalView If impost_t = "ITPOOSAJD" Then .Zoom = 125 Else .Zoom = 150 End With Cells(1, 1).Activate With ActiveSheet.PageSetup .BlackAndWhite = True .BottomMargin = Application.InchesToPoints(0.393700787401575) .FooterMargin = Application.InchesToPoints(0.196850393700787) .HeaderMargin = Application.InchesToPoints(0.196850393700787) .LeftFooter = "&""Arial,Negrita""&8" & "Fecha: " & "&D" & " Hora: " & "&T" .LeftMargin = Application.InchesToPoints(0.393700787401575) .RightFooter = "&""Arial,Negrita""&8" & "Pàgina: " & "&P" & " de " & "&N" .RightHeader = "&""Arial,Negrita""&8" & _ "GOBIERNO DE CANARIAS: SIMCAN(v1.0) " & Chr(169) & " " & Chr(174) & _ " (" & impost_t & ")" .RightMargin = Application.InchesToPoints(0.393700787401575) .TopMargin = Application.InchesToPoints(0.393700787401575) If opcio = "R" Then .Zoom = IIf(impost_t = "ITPOOSAJD", 70, IIf(impost_t = "IRPF", 73, 80)) Else .Zoom = IIf(impost_t = "ITPOOSAJD", 100, 85) End If End With ActiveSheet.Protect (SECRET) ActiveWorkbook.Protect (SECRET) Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate 'Application.ScreenUpdating = True End Sub Attribute VB_Name = "Impostos" Option Explicit Sub SIMCAN_IMPOSTOS() Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate ActiveWindow.DisplayWorkbookTabs = False Application.DisplayAlerts = False SORTIR = False If OBRIR = 1 Then SIMCAT_Caratula.MultiPage1.Value = 0 SIMCAT_Caratula.Show If SORTIR Then GoTo SURT End If Dim ianyb(1 To 5) As Integer, isim(1 To 5) As Integer, i1 As Integer, j1 As Integer, temps As Date ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' Determina els anys de les bases de dades dels tres impostos' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' For j1 = 1 To 5 ianyb(j1) = 0 For i1 = 2018 To IIf(j1 = 1, 2015, IIf(j1 = 2, 2013, IIf(j1 = 3, 2013, IIf(j1 = 4, 2017, 2012)))) Step -1 If Dir(IIf(j1 = 1, NOM_IRPF_DADES, _ IIf(j1 = 2, NOM_IS_DADES, _ IIf(j1 = 3, NOM_ID_DADES, _ IIf(j1 = 4, NOM_IT_DADES, NOM_IPPF_DADES)))) & Trim(Str(i1)) & ".dat") <> "" Then ianyb(j1) = ianyb(j1) + 1 If j1 = 1 Then ReDim Preserve AIRPF(0 To ianyb(j1) - 1) AIRPF(ianyb(j1) - 1) = i1 ElseIf j1 = 2 Then ReDim Preserve AIS(0 To ianyb(j1) - 1) AIS(ianyb(j1) - 1) = i1 ElseIf j1 = 3 Then ReDim Preserve AID(0 To ianyb(j1) - 1) AID(ianyb(j1) - 1) = i1 ElseIf j1 = 4 Then ReDim Preserve AIT(0 To ianyb(j1) - 1) AIT(ianyb(j1) - 1) = i1 ElseIf j1 = 5 Then ReDim Preserve AIPPF(0 To ianyb(j1) - 1) AIPPF(ianyb(j1) - 1) = i1 End If End If Next i1 Next j1 For j1 = 1 To 5 If j1 = 1 Then IMPOST(j1) = True Else IMPOST(j1) = False ISIMULS(j1) = 0 If ianyb(j1) = 0 Then If j1 = 1 Then ReDim AIRPF(0) AIRPF(0) = "Sin datos" ElseIf j1 = 2 Then ReDim AIS(0) AIS(0) = "Sin datos" ElseIf j1 = 3 Then ReDim AID(0) AID(0) = "Sin datos" ElseIf j1 = 4 Then ReDim AIT(0) AIT(0) = "Sin datos" ElseIf j1 = 5 Then ReDim AIPPF(0) AIPPF(0) = "Sin datos" End If End If Next j1 INICI: ERR_LEC = True COMPARA = 0 RES = 0 SIMUL = 0 SORTIR = False Do While ERR_LEC With Inicial If IMPOST(1) Then .MultiPage1.Value = 0 ElseIf IMPOST(2) Then .MultiPage1.Value = 1 ElseIf IMPOST(3) Then .MultiPage1.Value = 2 ElseIf IMPOST(4) Then .MultiPage1.Value = 3 ElseIf IMPOST(5) Then .MultiPage1.Value = 4 End If .ListBox_IRPF.List = AIRPF .ListBox_IS.List = AIS .ListBox_ID.List = AID .ListBox_IT.List = AIT .ListBox_IPPF.List = AIPPF If AIRPF(0) = "Sin datos" Then .ListBox_IRPF.Enabled = False If AIS(0) = "Sin datos" Then .ListBox_IS.Enabled = False If AID(0) = "Sin datos" Then .ListBox_ID.Enabled = False If AIT(0) = "Sin datos" Then .ListBox_IT.Enabled = False If AIPPF(0) = "Sin datos" Then .ListBox_IPPF.Enabled = False .Show End With If SORTIR Then GoTo SURT Loop If SIMUL <> 0 Then Call COMUNS_1REFERENCIA(IIf(SIMUL = 1, "IRPF", _ IIf(SIMUL = 2, "IS", _ IIf(SIMUL = 3, "ID", _ IIf(SIMUL = 4, "IT", "IPPF"))))) 'Valors referència If SIMUL = 1 Then Call IRPF_10PARAMETRES(1) 'Paràmetres simulació If SIMUL = 2 Then Call IS_10PARAMETRES(1) If SIMUL = 3 Then Call ISD_10PARAMETRES(1) If SIMUL = 4 Then Call IT_10PARAMETRES(1) If SIMUL = 5 Then Call IPPF_10PARAMETRES(1) If SORTIR Then GoTo INICI Application.DisplayStatusBar = True Application.StatusBar = "Inici del proceso de simulación. Calculando..." Application.Wait (Now + TimeValue("0:00:01")) temps = Now If SIMUL = 1 Then Call IRPF_10PROJECCIO_PES(2) 'Projeccions IRPF ' Call IRPF_20SIMULACIO_2017(1) 'Simulació IRPF-2017 End If If SIMUL = 2 Then Call IS_20SIMULACIO(1) 'Simulació IS If SIMUL = 3 Then Call ISD_20SIMULACIO(1) 'Simulació ISD If SIMUL = 4 Then Call IT_20SIMULACIO(1) 'Simulació IT If SIMUL = 5 Then Call IPPF_20SIMULACIO(1) 'Simulació IPPF Call COMUNS_3ESCRIPTURA_AUXILIAR(IIf(SIMUL = 1, "IRPF", _ IIf(SIMUL = 2, "IS", _ IIf(SIMUL = 3, "ID", _ IIf(SIMUL = 4, "IT", "IPPF"))))) 'Escriptura resultats auxiliars Application.StatusBar = "Final del proceso de simulación: Tiempo de cálculo empleado=" & DateDiff("s", temps, Now) & " segundos. Registros procesados=" & Format(N, "###,##0") & "." Application.Wait (Now + TimeValue("0:00:05")) Application.StatusBar = "" GoTo INICI End If If COMPARA <> 0 Then Dim avis_c As Boolean avis_c = False Application.DisplayStatusBar = True Application.StatusBar = "Inicio del proces de comparación. Calculando..." temps = Now If COMPARA = 1 Then Call IRPF_30COMPARACIO(avis_c) If COMPARA = 2 Then Call IS_30COMPARACIO(1) If COMPARA = 3 Then Call ISD_30COMPARACIO(1) If COMPARA = 4 Then Call IT_30COMPARACIO(1) If COMPARA = 5 Then Call IPPF_30COMPARACIO(1) If avis_c Then Application.StatusBar = "" Else Application.StatusBar = "Final del proceso de comparación: Tiempo de calculo empleado=" & DateDiff("s", temps, Now) & " segundos. Registros procesados=" & N & "." Application.Wait (Now + TimeValue("0:00:03")) Application.StatusBar = "" End If GoTo INICI End If If RES <> 0 Then Application.DisplayStatusBar = True Application.StatusBar = "Generant resultats..." Application.Wait (Now + TimeValue("0:00:01")) If RES = 1 Then Call IRPF_40ESCRIPTURA(1) 'Escriptura simulacions If RES = 2 Then Call IS_40ESCRIPTURA(1) If RES = 3 Then Call ISD_40ESCRIPTURA(1) If RES = 4 Then Call IT_40ESCRIPTURA(1) If RES = 5 Then Call IPPF_40ESCRIPTURA(1) Application.StatusBar = "" GoTo INICI End If SURT: Application.ScreenUpdating = True Application.DisplayAlerts = True ActiveWindow.DisplayWorkbookTabs = True OBRIR = 0 End Sub Private Sub IRPF_10PARAMETRES(opcio As Integer) Dim i1 As Integer, i2 As Integer Call IRPF_10PROJECCIO_PES(1) ' Projeccions ReDim aux_proj(300), aux1_5(5), aux5_15(11), aux10_20(11), aux11(11), aux161(11), aux162(11), aux163(11), tram(9) As Integer For i1 = -150 To 150 aux_proj(150 - i1) = i1 / 10 Next i1 For i1 = 0 To 11 If i1 <= 5 Then aux1_5(i1) = 5 - i1 aux5_15(i1) = IIf(i1 < 11, 15 - i1, 0) aux10_20(i1) = IIf(i1 < 11, 20 - i1, 0) aux11(i1) = IIf(i1 < 11, 200 - (5 * i1), 0) / 100 aux161(i1) = IIf(i1 < 11, 400 - (5 * i1), 0) / 10 aux162(i1) = IIf(i1 < 11, 20 - i1, 0) aux163(i1) = IIf(i1 < 11, 200 - (5 * i1), 0) / 10 If i1 < 10 Then tram(i1) = 10 - i1 Next i1 If ISIMULS(1) <> 0 Then ReDim sims(1 To ISIMULS(1)) For i1 = ISIMULS(1) To 1 Step -1 sims(ISIMULS(1) - i1 + 1) = CIRPF(i1) Next i1 End If ReDim PARMS(42, 27) 'Aquí redimensiona PARMS() que s'utilitza al formulari IRPF PAGINA = -1 TORNA: PAGINA = PAGINA + 1 ERR_LEC = True Do While ERR_LEC With IRPF .MultiPage1.Value = PAGINA If .MultiPage1.Value = 0 Then .Caption = "SIMCAN-IRPF: Mínimos Personales y Reducciones" If .MultiPage1.Value = 1 Then .Caption = "SIMCAN-IRPF: Tarifas Base General y del ahorro" If .MultiPage1.Value = 2 Then .Caption = "SIMCAN-IRPF: Deducciones Generales y Autonómicas" .Caption = .Caption & " (Base de datos: " & ANOIRPF & ")" If ISIMULS(1) <> 0 Then .ListBox_SimulRef.List = sims End If If .CheckBox10.Value = False Then .Label1102.Top = 20 .Frame1122.Left = 72 End If .ListBox21.List = tram .ListBox221.List = tram .ListBox222.List = tram .ListBox23.List = tram If LIM_BASE <> 0 Then .Frame21.Left = 20 .Frame21.Top = 0 .Frame221.Caption = "BASE GENERAL CANARIAS (" & IIf(C_BASE = 1, "BIT", "BLT") & ") < " & Format(LIM_BASE, "###,###0") & "€" .Frame221.Left = 220 .Frame221.Top = 0 .Frame222.Caption = "BASE GENERAL CANARIAS (" & IIf(C_BASE = 1, "BIT", "BLT") & ") >= " & Format(LIM_BASE, "###,###0") & "€" .Frame222.Visible = True .Frame23.Left = 200 .Frame23.Top = 195 Else .Frame221.Caption = "BASE GENERAL CANARIAS" End If .ListBox_Proj.List = A_PROJ ' això es genera a la subrutina IRPF_10PROJECCIO_PES() .ListBox31.List = aux5_15 .ListBox32.List = aux5_15 .ListBox33.List = aux5_15 .ListBox361.List = aux1_5: .ListBox362.List = aux1_5: .ListBox363.List = aux1_5 .ListBox39.List = aux10_20 .ListBox3111.List = aux11: .ListBox3112.List = aux11 .ListBox312.List = aux5_15 .ListBox313.List = aux10_20 .ListBox3151.List = aux10_20: .ListBox3152.List = aux10_20 .ListBox3161.List = aux161: .ListBox3162.List = aux162: .ListBox3163.List = aux163 .ListBox320.List = aux5_15 .ListBox321.List = aux5_15 .ListBox021.List = aux_proj .ListBox022.List = aux_proj .ListBox023.List = aux_proj .ListBox024.List = aux_proj .ListBox025.List = aux_proj If PARMS(0, 3) = "OBLIGATS" Then .TotsNo.Value = True Else .TotsSi.Value = True .ListBox021.Selected(150) = True 'Projeccions .ListBox022.Selected(150) = True .ListBox023.Selected(150) = True .ListBox024.Selected(150) = True .ListBox025.Selected(150) = True .ListBox_Proj.Selected(LBound(A_PROJ)) = True For i1 = 0 To UBound(A_PROJ) If PARMS(0, 4) = A_PROJ(i1) Then .ListBox_Proj.Selected(i1) = True Exit For End If Next i1 .Show End With If SORTIR Then Exit Sub Loop If PAGINA < 2 Then GoTo TORNA If PAGINA = 2 Then Exit Sub End Sub Private Sub IRPF_10PROJECCIO_PES(opcio As Integer) Dim d_proj As Integer, i As Integer, j As Integer, j0 As Integer, j1 As Integer, nom As String nom = ThisWorkbook.Path & "\DADES\Projeccions.xlsx" Application.ScreenUpdating = False Set LLIBRE_PROJECCIONS = Workbooks.Open(nom) Workbooks(Workbooks.Count).Activate Sheets("ValorsAEAT").Activate If opcio = 1 Then d_proj = 0 ' Quants anys apareixen en les possibilitats de projecció For j = 2 To Cells(1, 1).End(xlToRight).Column '10 If Cells(1, j) > ANOIRPF And Cells(2, j) <> "" Then d_proj = d_proj + 1 Next j ReDim A_PROJ(d_proj) For i = 0 To d_proj A_PROJ(d_proj - i) = ANOIRPF + i Next i GoTo ACABAT_PROJ ElseIf opcio = 2 Then ReDim C_PROJ(1 To 10) For i = 1 To 10 C_PROJ(i) = 1 Next i If ANY_PROJ = ANOIRPF Then GoTo ACABAT_PROJ For j = 2 To Cells(1, 1).End(xlToRight).Column '10 If Cells(1, j) = ANOIRPF Then j0 = j Exit For End If Next j For j = 2 To Cells(1, 1).End(xlToRight).Column '10 If Cells(1, j) = ANY_PROJ Then j1 = j Exit For End If Next j For i = 0 To 9 C_PROJ(i + 1) = Cells(i + 2, j1) / Cells(i + 2, j0) Next i ' For i = 1 To 10 ' Debug.Print Format(C_PROJ(i), "0.0000") ' Next i End If ACABAT_PROJ: LLIBRE_PROJECCIONS.Close Application.ScreenUpdating = True End Sub Private Sub IRPF_10PROJECCIO_RENDIMENTS(p130, p155, p185, p226, _ p035, p048, p222, p223, p224, p225, _ p015, p018, aux, p075, p076, p240, p244, p248, p252, p481, _ p380, p388_391, _ p384, p393_404) ' rendes empresarials --> p130,p155,p185,p226 ' capital mobiliari --> p035,p048,p222,p223,p224,p225 ' resta rendes --> p015,p018,p021,p075,p076,p240,p244,p248,p252,p481 ' plusvàlues < 1 any --> p380,p376,p378,p379 ' plusvàlues > 1 any --> p384,p393_404 p130 = p130 * PROJ(1): p155 = p155 * PROJ(1): p185 = p185 * PROJ(1): p226 = p226 * PROJ(1) p035 = p035 * PROJ(2): p048 = p048 * PROJ(2): p222 = p222 * PROJ(2): p223 = p223 * PROJ(2): p224 = p224 * PROJ(2): p225 = p225 * PROJ(2) p015 = p015 * PROJ(3): p018 = p018 * PROJ(3): aux = aux * PROJ(3): p075 = p075 * PROJ(3): p076 = p076 * PROJ(3): p240 = p240 * PROJ(3): p244 = p244 * PROJ(3): p248 = p248 * PROJ(3): p252 = p252 * PROJ(3): p481 = p481 * PROJ(3) p380 = p380 * PROJ(4): p388_391 = p388_391 * PROJ(4) p384 = p384 * PROJ(5): p393_404 = p393_404 * PROJ(5) End Sub Private Sub IRPF_20SIMULACIO_2017(opcio As Integer) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim opcio2 As Integer opcio2 = 0 '0=res, altre=Calcula els resultats per a la memòria tributària If DECL_NOMBRE = "OBLIGATS" Then Call IRPF_6MEMORIA_TRIBUTARIA_OBRE(opcio2) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'X(i1, 1) renda total contribuent (RTCo) ............. p010 + p011 + ' ' p034 + p049 + ' ' p069 + p084 + ' ' p140 + p165 + p194 + ' ' p232 + p233 + p234 + p235 + p236 + ' ' p250 + p255 + p260 + p264 + ' ' p402 + p406 + ' ' p495 + p496 (ve calculada en el fitxer de lectura de dades) ' 'X(i1, 2) base imposable total (BIT) ................. BIG + v435 ' 'X(i1, 3) base liquidable total (BLT) ................ BLG + v480 ' 'X(i1, 4) base imposable general (BIG) ............... p402 + v412 - p411_414 ' 'X(i1, 5) base liquidable general (BLG) .............. BIG - v466 - v467 - v468 - v469 - v470 - v471 - v472 - p474 ' 'X(i1, 6) reduccions plans pensions .................. v467 + v468 + v469 + v470 + v472 ' 'X(i1, 7) reducció tributació conjunta ............... v466 + v476 ' 'X(i1, 8) quota deduïda MPF: ESTAT ................... qg(2, 1) + qe(2, 1) ' 'X(i1, 9) quota deduïda MPF: CATALUNYA ............... qg(2, 2) + qe(2, 2) ' 'X(i1, 10) quota base general: ESTAT .................. qg(1, 1) + qg(3, 1) - qg(2, 1) ' 'X(i1, 11) quota base estalvi: ESTAT .................. qe(1, 1) ' 'X(i1, 12) quota íntegra ESTAT......................... X(i1, 10) + X(i1, 11) ' 'X(i1, 13) quota base general: CATALUNYA .............. qg(1, 2) + qg(3, 2) - qg(2, 2) ' 'X(i1, 14) quota base estalvi: CATALUNYA .............. qe(1, 2) ' 'X(i1, 15) quota íntegra CATALUNYA .................... X(i1, 13) + X(i1, 14) ' 'X(i1, 16) quota íntegra total ........................ X(i1, 12) + X(i1, 15) ' 'X(i1, 17) deducció habitatge habitual ESTAT S/QIE .... b_viv1 + b_viv2 + p531 ' 'X(i1, 18) resta deduccions ESTAT s/QIE ............... p518_529 ' 'X(i1, 19) deducció habitatge habitual CCAA S/QIA ..... b_viv1 + b_viv2 + p532 ' 'X(i1, 20) resta deduccions CATALUNYA s/QIA ........... p520_530 ' 'X(i1, 21) Deduccions CATALUNYA específiques s/QIA .... p917 + p918 + p919 + p920 + p921 + p922 + p923 + p924 + p925 ' 'X(i1, 22) quota líquida incrementada ESTAT ........... X(i1,12) - X(i1,17) - X(i1,18) + p537_541 ' 'X(i1, 23) quota líquida incrementada Catalunya ....... X(i1,15) - X(i1,19) - X(i1,20) - X(i1,21) + p542_546 ' 'X(i1, 24) quota líquida incrementada total ........... X(i1,22) + X(i1,23) ' 'X(i1, 25) deduccions, doble imp, compens. i retencions p553_555 + p556 ' 'X(i1, 26) quota resultant autoliquidació ............. X(i1,24) - X(i1,25) ' 'X(i1, 27) deducció maternitat, disc., fam. nombrosa .. p571_611 ' 'X(i1, 28) resultat declaració ........................ X(i1,26) - X(i1,27) ' 'X(i1, 29) factor elevació ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' 'Càlcul preliminar sobre trams i tipus impositius' '''''''''''''''''''''''''''''''''''''''''''''''''' Dim auxntramsg As Integer, it As Integer, j1 As Integer auxntramsg = Application.Max(NTRAMSG(1), NTRAMSG(2), NTRAMSG(3)) ReDim tt(1 To auxntramsg - IIf(auxntramsg = 1, 0, 1), 1 To 3) As Double For j1 = 1 To 3 tt(1, j1) = TG(1, j1) * TIPUSG(1, j1) If NTRAMSG(j1) > 2 Then For it = 2 To NTRAMSG(j1) - 1 tt(it, j1) = tt(it - 1, j1) + ((TG(it, j1) - TG(it - 1, j1)) * TIPUSG(it, j1)) Next it End If Next j1 ReDim tte(1 To NTRAMSE - IIf(NTRAMSE = 1, 0, 1), 1 To 2) As Double For j1 = 1 To 2 tte(1, j1) = TE(1, j1) * TIPUSE(1, j1) If NTRAMSE > 2 Then For it = 2 To NTRAMSE - 1 tte(it, j1) = tte(it - 1, j1) + ((TE(it, j1) - TE(it - 1, j1)) * TIPUSE(it, j1)) Next it End If Next j1 ''''''''''''''''''''''''''''''''''''''''''''''''' 'Declaracions de variables del fitxer de lectura' ''''''''''''''''''''''''''''''''''''''''''''''''' Dim b_viv1 As Double, b_viv2 As Double, cminus As Integer, cd As Integer, csel As Integer, dminus As Integer, ec As Integer, ed As Integer, _ estciv As Integer, estrat As Integer, i_fills As Double, i_grans As Double, i_minus As Integer, i_viv As Integer, na As Integer, _ na65 As Integer, na75 As Integer, na_33 As Integer, na_331 As Integer, na_65 As Integer, nd As Integer, nd16_17 As Integer, _ nd18_24 As Integer, nd25 As Integer, nd3 As Integer, nd3_15 As Integer, nd_33 As Integer, nd_331 As Integer, nd_65 As Integer, _ obligado As Integer, p017 As Double, i019 As Double, i020 As Double, p020 As Double, i022 As Integer, p039 As Double, _ p054 As Double, p084 As Double, p085 As Double, p140 As Double, p165 As Double, p194 As Double, p232 As Double, p233 As Double, _ p234 As Double, p235 As Double, p236 As Double, p250 As Double, p255 As Double, p260 As Double, p264 As Double, p402 As Double, _ p406 As Double, p411_414 As Double, p416_431 As Double, p443 As Double, p444 As Double, p451 As Double, p456 As Double, p461 As Double, _ p465 As Double, p474 As Double, p497 As Double, p518_529 As Double, p520_530 As Double, p531 As Double, p532 As Double, p917 As Double, _ p918 As Double, p919 As Double, p920 As Double, p921 As Double, p922 As Double, p923 As Double, p924 As Double, p925 As Double, _ p537_541 As Double, p542_546 As Double, p552 As Double, p553_555 As Double, p556 As Double, p571_611 As Double, _ pes As Double, registre As Long, RTCo As Double, sex As Integer, uf As Integer '''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Declaracions de variables pel càlcul de la simulació' '''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim be(1 To 2) As Double, bg(1 To 3) As Double, mpfv(1 To 3) As Double, qg(1 To 3, 1 To 3) As Double, qe(1 To 2, 1 To 2) As Double, _ vpag(1 To 4) As Double, vx(1 To 28, 1 To 6) As Double, _ aux As Double, aux1 As Double, aux2 As Double, aux12 As Double, aux15 As Double, aux21 As Double, aux917 As Double, _ i1 As Long, ii1 As Long, j2 As Integer, k1 As Integer, k2 As Integer, l1 As Integer, _ i_pag As Long, mpfc As Double, mpfe As Double, spes2 As Double, vgp As Double, _ v018 As Double, v019 As Double, v020 As Double, v021 As Double, v022 As Double, v023 As Double, v409 As Double, v412 As Double, _ v435 As Double, v466 As Double, v467 As Double, v468 As Double, v469 As Double, v470 As Double, v471 As Double, v472 As Double, _ v476 As Double, v477 As Double, v480 As Double, v491 As Double, v492 As Double, v493 As Double, v494 As Double, v531 As Double, _ v532 As Double, v917 As Double, v918 As Double, v919 As Double, v920 As Double, v921 As Double, v922 As Double, v923 As Double, _ v924 As Double, v925 As Double ReDim MITJANA(1 To 28), PAG(1 To 3), SUMA(1 To 28), VT(1 To 349, 12) '''''''''''''''''' 'Lectura de dades' '''''''''''''''''' Open NOM_IRPF_DADES & ANOIRPF & ".dat" For Input As #1 Input #1, N1, N2 'N1=Obligats N2=No Obligats N = N1 + IIf(DECL_NOMBRE = "TOTS", N2, 0) ''''''''''''''''''''''''''''''''''''''''''''''''' 'Declaracions de variables després de conèixer N' ''''''''''''''''''''''''''''''''''''''''''''''''' ReDim CATEG(1 To N) As Integer, IDENTIFICADOR(1 To N), IND(1 To N, 1 To 3), X(1 To N, 1 To 33) NT = 0 spes2 = 0 i1 = 0 For ii1 = 1 To N1 + N2 i_pag = 0 Input #1, registre, obligado, ed, ec, cminus, dminus, estciv, sex, cd, uf, csel, _ i_fills, nd, nd3, nd3_15, nd16_17, nd18_24, nd25, nd_33, nd_331, nd_65, i_grans, na, na65, na75, na_33, na_331, na_65, i_minus, _ i_viv, b_viv1, b_viv2, _ p017, i019, p020, i020, i022, p054, p084, p085, p140, p165, p194, p232, _ p235, p236, p250, p255, p260, p264, p402, p411_414, _ p039, p233, p234, _ p406, p416_431, _ p443, p444, p451, p456, p461, p465, _ p474, p497, _ p518_529, p520_530, p531, p532, _ p917, p918, p919, p920, p921, p922, p923, p924, p925, _ p537_541, p542_546, p552, p553_555, p556, p571_611, pes, RTCo, estrat If DECL_NOMBRE <> "TOTS" And obligado = 0 Then GoTo SALTA_TOTS i1 = i1 + 1 CATEG(i1) = csel IND(i1, 1) = i1 'ordenació per RTCo, tal com està ordenada la base de dades IDENTIFICADOR(i1) = registre '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' X(i1, 1) = RTCo 'RENDA TOTAL DEL CONTRIBUENT=RTCo X(i1, 29) = pes 'FACTOR D'ELEVACIÓ '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' For j1 = 1 To 10 If estrat = j1 Then X(i1, 29) = X(i1, 29) * C_PROJ(j1) ' projecció dels declarants Next j1 If (ANY_PROJ = ANOIRPF) And (PROJ(1) <> 1 Or PROJ(2) <> 1 Or PROJ(3) <> 1 Or PROJ(4) <> 1 Or PROJ(5) <> 1) Then aux = 0 Call IRPF_10PROJECCIO_RENDIMENTS(p140, p165, p194, p236, _ p039, p054, p232, p233, p234, p235, _ p017, p020, aux, p084, p085, p250, p255, p260, p264, p497, _ p402, p411_414, _ p406, p416_431) '******************ull amb p021 End If aux = 0: v018 = 0: v019 = 0: v020 = 0 If DDRT(0) = 1 And p017 > 0 Then v018 = Application.Min(p017, DDRT(1)) 'Despeses deduïbles ingressos treball: generals v019 = Application.Min(p017 - v018, i019 * DDRT(2)) 'Despeses deduïbles ingressos treball: trasllat If i020 <> 0 Then 'Despeses deduïbles ingressos treball: discapacitats If p020 <= 3500 Then v020 = Application.Min(p017 - v018 - v019, DDRT(3) * i020) If p020 > 3500 Then v020 = Application.Min(p017 - v018 - v019, DDRT(4) * i020) End If End If v021 = p017 - v018 - v019 - v020 'Rendiment net treball v022 = 0 If RT(0, 0) = 1 And p017 > 0 And v021 > 0 Then If i022 = 1 Then If p017 <= RT(2, 2) Then If p017 <= RT(1, 2) Then 'Reducció rendiments treball: general v022 = Application.Min(v021, RT(1, 3)) Else v022 = Application.Min(v021, RT(1, 3) - RT(2, 4) * (p017 - RT(1, 2))) End If End If ElseIf i022 = 0 Then ' If (p054 + p084 + p085 + p140 + p165 + p194 + p232 + p235 + p236 + p250 + p255 + p259 + p264 + p402) < 6500 And _ ' (p039 + p233 + p234 + p406) < 6500 Then i022 = 1 'aqui s'ha afegit p402 If RT(2, 2) > IRPF_RED_RT(2, 2) And p017 < RT(2, 2) Then aux1 = Application.Max(0, p054) + Application.Max(0, p084) + Application.Max(0, p085) + _ Application.Max(0, p140) + Application.Max(0, p165) + Application.Max(0, p194) + _ Application.Max(0, p232) + Application.Max(0, p235) + Application.Max(0, p236) + _ Application.Max(0, p250) + Application.Max(0, p255) + Application.Max(0, p260) + Application.Max(0, p264) + _ Application.Max(0, p402) aux2 = Application.Max(0, p039) + Application.Max(0, p233) + Application.Max(0, p234) + Application.Max(0, p406) If aux1 + aux2 < 6500 Then i022 = 1 If p017 <= RT(1, 2) Then 'Reducció rendiments treball: general v022 = Application.Min(v021, RT(1, 3)) Else v022 = Application.Min(v021, RT(1, 3) - RT(2, 4) * (p017 - RT(1, 2))) End If End If End If End If End If v023 = v021 - v022 'Rendiment net reduït treball v412 = v023 + p054 + p084 + p085 + p140 + p165 + p194 + p232 + p235 + p236 + _ p250 + p255 + p260 + p264 'Saldo net de rendiments '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' X(i1, 4) = p402 + v412 - p411_414 'BASE IMPOSABLE GENERAL=BIG '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' v466 = 0 If RTC(0) = 1 And cd = 1 And X(i1, 4) > 0 Then If uf = 1 Then v466 = Application.Min(X(i1, 4), RTC(1)) 'Reducció efectiva per tributació conjunta: normal If uf = 2 Then v466 = Application.Min(X(i1, 4), RTC(2)) 'Reducció efectiva per tributació conjunta: especial End If aux = 0: v467 = 0: v468 = 0: v469 = 0: v470 = 0: v471 = 0: v472 = 0 If RPP(0) = 1 And X(i1, 4) > 0 Then If p443 > 0 Then aux = Application.Max(0, X(i1, 4) - v466) v467 = Application.Min(p443, RPP(1), aux) 'Reducció efectiva sistemas previsió (general) End If If p444 > 0 Then aux = Application.Max(0, X(i1, 4) - v466 - v467) v468 = Application.Min(p444, RPP(2), aux) 'Reducció efectiva sistemas previsió cònjuge End If If p451 > 0 Then aux = Application.Max(0, X(i1, 4) - v466 - v467 - v468) v469 = Application.Min(p451, RPP(3), aux) 'Reducció efectiva sistemas previsió discapacitats End If If p456 > 0 Then aux = Application.Max(0, X(i1, 4) - v466 - v467 - v468 - v469) v470 = Application.Min(p456, RPP(3), aux) 'Reducció efectiva aportacions patrimonis discapacitats End If If p461 > 0 Then aux = Application.Max(0, X(i1, 4) - v466 - v467 - v468 - v469 - v470) v471 = Application.Min(p461, aux) 'Reducció efectiva pensions compensatories End If If p465 > 0 Then aux = Application.Max(0, X(i1, 4) - v466 - v467 - v468 - v469 - v470 - v471) v472 = Application.Min(p465, RPP(4), aux) 'Reducció efectiva mutual. prev. esport. prof. End If End If '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' X(i1, 5) = X(i1, 4) - v466 - v467 - v468 - v469 - v470 - v471 - v472 - p474 'BASE LIQUIDABLE GENERAL SOTMESA A GRAVAMEN=BLG X(i1, 6) = v467 + v468 + v469 + v470 + v472 'REDUCCIONS PLANS DE PENSIONS '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' v409 = 0: v435 = 0: v476 = 0: v477 = 0: v480 = 0 If obligado = 1 Then v409 = Application.Max(0, p039 + p233 + p234) 'Saldo net positiu del capital mobiliari v435 = Application.Max(0, p406 + v409 - p416_431) 'Base imposable de l'estalvi If RTC(0) = 1 And cd = 1 And v435 > 0 Then If uf = 1 Then v476 = Application.Min(Application.Max(0, RTC(1) - v466), v435) 'Romanent BIE Tributació conjunta: normal If uf = 2 Then v476 = Application.Min(Application.Max(0, RTC(2) - v466), v435) 'Romanent BIE Tributació conjunta: especial End If v477 = Application.Min(Application.Max(0, p461 - v471), v435 - v476) 'Romanent BIE pensions compensatòries i anualitats aliments v480 = Application.Max(0, v435 - v476 - v477 - MINIM_EXEMPTE) 'Base liquidable de l'estalvi End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' AIXÒ ÉS PER A FER COMPROVACIONS (Reduccions treball i Rendiments) (només obligats) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' 'IF NOMBRE_DECL="OBLIGATS" THEN ' If i1 = 1 Then ' Open ThisWorkbook.Path & "\COMPROVACIONS\IRPF\Comprovacions(" & RT(2, 4) & ").txt" For Output As #101 ' Write #101, "registre", "p017", "v018", "v019", "i019", "p020", "i020", "v020", "v021", "i022", "v022", "v023", "v412", "v435", "BIG", "pes" ' End If ' Write #101, registre, p017, v018, v019, i019, p020, i020, v020, v021, i022, v022, v023, v412, v435, X(i1, 4), pes ' If i1 = N1 Then Close #101 'End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' X(i1, 2) = X(i1, 4) + v435 'BASE IMPOSABLE TOTAL=BIT X(i1, 3) = X(i1, 5) + v480 'BASE LIQUIDABLE TOTAL=BLT X(i1, 7) = v466 + v476 'REDUCCIÓ TRIBUTACIÓ CONJUNTA '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS (Reduccions a la base) (només obligats) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' 'IF NOMBRE_DECL="OBLIGATS" THEN ' If i1 = 1 Then ' Open ThisWorkbook.Path & "\COMPROVACIONS\IRPF\Comprovacions2.txt" For Output As #102 ' Write #102, "X(i1, 4)", "v466", "v467", "v68", "v469", "v470", "v471", "v472", "X(i1, 5)", "v435", "v476", "v477", "v480", "pes" ' End If ' Write #102, X(i1, 4), v466, v467, v468, v469, v470, v471, v472, X(i1, 5), v435, v476, v477, v480, pes ' If i1 = N1 Then Close #102 'End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' v491 = 0: v492 = 0: v493 = 0: v494 = 0 If MPF(0, 0) = 1 Then For k2 = 1 To 2 k1 = k2 If k2 = 2 And C_BASE = 1 And X(i1, 2) >= LIM_BASE Then k1 = 3 If k2 = 2 And C_BASE = 2 And X(i1, 3) >= LIM_BASE Then k1 = 3 mpfv(k1) = 0 mpfv(k1) = MPF(1, k1) If ed >= 65 Then mpfv(k1) = mpfv(k1) + MPF(6, k1) If ed >= 75 Then mpfv(k1) = mpfv(k1) + MPF(7, k1) If cd = 1 Then If ec >= 65 Then mpfv(k1) = mpfv(k1) + MPF(6, k1) If ec >= 75 Then mpfv(k1) = mpfv(k1) + MPF(7, k1) End If If i_fills <> 0 Then If nd >= 1 Then mpfv(k1) = mpfv(k1) + MPF(2, k1) / cd / i_fills If nd >= 2 Then mpfv(k1) = mpfv(k1) + MPF(3, k1) / cd / i_fills If nd >= 3 Then mpfv(k1) = mpfv(k1) + MPF(4, k1) / cd / i_fills If nd >= 4 Then mpfv(k1) = mpfv(k1) + (nd - 3) * MPF(5, k1) / cd / i_fills If nd3 <> 0 Then mpfv(k1) = mpfv(k1) + nd3 * MPF(10, k1) / cd / i_fills End If If i_grans <> 0 Then mpfv(k1) = mpfv(k1) + (na65 + na_33 + na_331 + na_65) * MPF(12, k1) / i_grans If na75 <> 0 Then mpfv(k1) = mpfv(k1) + na75 * MPF(13, k1) / i_grans End If If i_minus <> 0 Then If dminus = 33 Or dminus = 331 Then mpfv(k1) = mpfv(k1) + MPF(8, k1) If dminus = 65 Then mpfv(k1) = mpfv(k1) + MPF(9, k1) If dminus = 331 Or dminus = 65 Then mpfv(k1) = mpfv(k1) + MPF(11, k1) If cd = 1 Then If (cminus = 33 Or cminus = 331) Then mpfv(k1) = mpfv(k1) + MPF(8, k1) If cminus = 65 Then mpfv(k1) = mpfv(k1) + MPF(9, k1) If (cminus = 331 Or cminus = 65) Then mpfv(k1) = mpfv(k1) + MPF(11, k1) End If If i_fills <> 0 Then If nd_33 <> 0 Or nd_331 <> 0 Then mpfv(k1) = mpfv(k1) + (nd_33 + nd_331) * MPF(8, k1) / cd / i_fills If nd_65 <> 0 Then mpfv(k1) = mpfv(k1) + nd_65 * MPF(9, k1) / cd / i_fills If nd_331 <> 0 Or nd_65 <> 0 Then mpfv(k1) = mpfv(k1) + (nd_331 + nd_65) * MPF(11, k1) / cd / i_fills End If If i_grans <> 0 Then If na_33 <> 0 Or na_331 <> 0 Then mpfv(k1) = mpfv(k1) + (na_33 + na_331) * MPF(8, k1) If na_65 <> 0 Then mpfv(k1) = mpfv(k1) + na_65 * MPF(9, k1) If na_331 <> 0 Or na_65 <> 0 Then mpfv(k1) = mpfv(k1) + (na_331 + na_65) * MPF(11, k1) End If End If Next k2 If X(i1, 5) > 0 Then v491 = Application.Min(mpfv(1), X(i1, 5)) 'mínim personal i familiar BLG: estat If C_BASE = 0 Then v493 = Application.Min(mpfv(2), X(i1, 5)) 'mínim personal i familiar BLG: CATALUNYA ElseIf C_BASE = 1 Then If X(i1, 2) < LIM_BASE Then v493 = Application.Min(mpfv(2), X(i1, 5)) If X(i1, 2) >= LIM_BASE Then v493 = Application.Min(mpfv(3), X(i1, 5)) ElseIf C_BASE = 2 Then If X(i1, 3) < LIM_BASE Then v493 = Application.Min(mpfv(2), X(i1, 5)) If X(i1, 3) >= LIM_BASE Then v493 = Application.Min(mpfv(3), X(i1, 5)) End If End If If obligado = 1 And v480 > 0 Then v492 = Application.Min(mpfv(1) - v491, v480) 'mínim personal i familiar BLE: estat If C_BASE = 0 Then v494 = Application.Min(mpfv(2) - v493, v480) 'mínim personal i familiar BLE: CATALUNYA ElseIf C_BASE = 1 Then If X(i1, 2) < LIM_BASE Then v494 = Application.Min(mpfv(2) - v493, v480) If X(i1, 2) >= LIM_BASE Then v494 = Application.Min(mpfv(3) - v493, v480) ElseIf C_BASE = 2 Then If X(i1, 3) < LIM_BASE Then v494 = Application.Min(mpfv(2) - v493, v480) If X(i1, 3) >= LIM_BASE Then v494 = Application.Min(mpfv(3) - v493, v480) End If End If End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS (Mínims personals) (només obligats) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' 'IF NOMBRE_DECL="OBLIGATS" THEN ' If i1 = 1 Then ' Open ThisWorkbook.Path & "\COMPROVACIONS\IRPF\Comprovacions3.txt" For Output As #103 ' Write #103, "X(i1, 5)", "v491", "v493", "v480", "v492", "v494", "pes" ' End If ' Write #103, X(i1, 5), v491, v493, v480, v492, v494, pes ' If i1 = N1 Then Close #103 'End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' bg(1) = 0: bg(2) = 0: bg(3) = 0 qg(1, 1) = 0: qg(1, 2) = 0: qg(1, 3) = 0: qg(2, 1) = 0: qg(2, 2) = 0: qg(1, 3) = 0: qg(3, 1) = 0: qg(3, 2) = 0: qg(3, 3) = 0: mpfe = 0: mpfc = 0 If X(i1, 5) > 0 Then bg(1) = X(i1, 5) '1a. quota mpfe = Application.Min(X(i1, 5), v491) '2a. quota mpf: ESTAT mpfc = Application.Min(X(i1, 5), v493) '2a. quota mpf: CATALUNYA If p497 > 0 And p497 < X(i1, 5) Then bg(1) = X(i1, 5) - p497 bg(3) = p497 '3a. quota anualitats aliments decisió judicial mpfe = Application.Min(X(i1, 5), v491 + IIf(MPF(0, 0) = 1, 1980, 0)) '2a. quota mpf: ESTAT mpfc = Application.Min(X(i1, 5), v493 + IIf(MPF(0, 0) = 1, 1980, 0)) '2a. quota mpf: CATALUNYA End If For j2 = 1 To 2 'j1=1 ESTAT, j1=2 CATALUNYA j1 = j2 If j2 = 2 And C_BASE = 1 And X(i1, 2) >= LIM_BASE Then j1 = 3 If j2 = 2 And C_BASE = 2 And X(i1, 3) >= LIM_BASE Then j1 = 3 bg(2) = IIf(j1 = 1, mpfe, mpfc) For k1 = 1 To 3 '1,2 o 3 passades per tarifa. la 3a quan p481>0 i p481 0 Then If NTRAMSG(j1) = 1 Then qg(k1, j1) = bg(k1) * TIPUSG(1, j1) Else it = NTRAMSG(j1) If bg(k1) <= TG(1, j1) Then qg(k1, j1) = bg(k1) * TIPUSG(1, j1) If NTRAMSG(j1) > 2 Then For l1 = 2 To NTRAMSG(j1) - 1 If bg(k1) > TG(l1 - 1, j1) And bg(k1) <= TG(l1, j1) Then qg(k1, j1) = tt(l1 - 1, j1) + ((bg(k1) - TG(l1 - 1, j1)) * TIPUSG(l1, j1)) Next l1 End If If bg(k1) > TG(it - 1, j1) Then qg(k1, j1) = tt(it - 1, j1) + ((bg(k1) - TG(it - 1, j1)) * TIPUSG(it, j1)) End If End If Next k1 Next j2 End If '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' X(i1, 8) = Application.Max(0, qg(2, 1)) 'QUOTA DEDUÏDA MPF: ESTAT If C_BASE = 0 Then X(i1, 9) = Application.Max(0, qg(2, 2)) 'QUOTA DEDUÏDA MPF: CATALUNYA ElseIf C_BASE = 1 Then If X(i1, 2) < LIM_BASE Then X(i1, 9) = Application.Max(0, qg(2, 2)) If X(i1, 2) >= LIM_BASE Then X(i1, 9) = Application.Max(0, qg(2, 3)) ElseIf C_BASE = 2 Then If X(i1, 3) < LIM_BASE Then X(i1, 9) = Application.Max(0, qg(2, 2)) If X(i1, 3) >= LIM_BASE Then X(i1, 9) = Application.Max(0, qg(2, 3)) End If X(i1, 10) = Application.Max(0, qg(1, 1) + qg(3, 1) - X(i1, 8)) 'QUOTA BASE GENERAL: ESTAT If C_BASE = 0 Then X(i1, 13) = Application.Max(0, qg(1, 2) + qg(3, 2) - X(i1, 9)) 'QUOTA BASE GENERAL: CATALUNYA ElseIf C_BASE = 1 Then If X(i1, 2) < LIM_BASE Then X(i1, 13) = Application.Max(0, qg(1, 2) + qg(3, 2) - X(i1, 9)) If X(i1, 2) >= LIM_BASE Then X(i1, 13) = Application.Max(0, qg(1, 3) + qg(3, 3) - X(i1, 9)) ElseIf C_BASE = 2 Then If X(i1, 3) < LIM_BASE Then X(i1, 13) = Application.Max(0, qg(1, 2) + qg(3, 2) - X(i1, 9)) If X(i1, 3) >= LIM_BASE Then X(i1, 13) = Application.Max(0, qg(1, 3) + qg(3, 3) - X(i1, 9)) End If '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' be(1) = 0: be(2) = 0: qe(1, 1) = 0: qe(1, 2) = 0: qe(2, 1) = 0: qe(2, 2) = 0 If obligado = 1 And v480 > 0 Then be(1) = v480 For j1 = 1 To 2 'j1=1 ESTAT, j1=2 CATALUNYA be(2) = Application.Min(v480, IIf(j1 = 1, v492, v494)) For k1 = 1 To 2 'k1=1 BLE, k1=2 MPFE If be(k1) > 0 Then If NTRAMSE = 1 Then qe(k1, j1) = be(k1) * TIPUSE(1, j1) Else it = NTRAMSE If be(k1) <= TE(1, j1) Then qe(k1, j1) = be(k1) * TIPUSE(1, j1) If NTRAMSE > 2 Then For l1 = 2 To NTRAMSE - 1 If be(k1) > TE(l1 - 1, j1) And be(k1) <= TE(l1, j1) Then qe(k1, j1) = tte(l1 - 1, j1) + ((be(k1) - TE(l1 - 1, j1)) * TIPUSE(l1, j1)) Next l1 End If If be(k1) > TE(it - 1, j1) Then qe(k1, j1) = tte(it - 1, j1) + ((be(k1) - TE(it - 1, j1)) * TIPUSE(it, j1)) End If End If Next k1 Next j1 End If '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' X(i1, 8) = X(i1, 8) + qe(2, 1) 'QUOTA DEDUÏDA MPF: ESTAT (afegint la part de BE) X(i1, 9) = X(i1, 9) + qe(2, 2) 'QUOTA DEDUÏDA MPF: CATALUNYA (afegint la part de BE) X(i1, 11) = Application.Max(0, qe(1, 1) - qe(2, 1)) 'QUOTA BASE ESTALVI: ESTAT X(i1, 14) = Application.Max(0, qe(1, 2) - qe(2, 2)) 'QUOTA BASE ESTALVI: CATALUNYA X(i1, 12) = X(i1, 10) + X(i1, 11) 'QUOTA ÍNTEGRA: ESTAT X(i1, 15) = X(i1, 13) + X(i1, 14) 'QUOTA ÍNTEGRA: CATALUNYA X(i1, 16) = X(i1, 12) + X(i1, 15) 'QUOTA ÍNTEGRA: TOTAL '-------------------------------------------------------------------------------------' '-------------------------------------------------------------------------------------' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' AIXÒ ÉS PER A FER COMPROVACIONS (Quotes per bases i íntegres) (només obligats) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' 'IF NOMBRE_DECL="OBLIGATS" THEN ' If i1 = 1 Then ' Open ThisWorkbook.Path & "\COMPROVACIONS\IRPF\Comprovacions4.txt" For Output As #104 ' Write #104, "q ESTAT(MPF)", "q ESTAT(BG)", "q ESTAT(BE)", "qi ESTAT", "q CAT(MPF)", "q CCAA(BG)", "q CAT(BE)", "qi CAT", "pes" ' End If ' Write #104, X(i1, 8), X(i1, 10), X(i1, 11), X(i1, 12), X(i1, 9), X(i1, 13), X(i1, 14), X(i1, 15), pes ' If i1 = N1 Then Close #104 'End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' If obligado = 0 Then GoTo NO_OBLIGATS If DED(0) = 1 Then aux12 = X(i1, 12) aux15 = X(i1, 15) If DEDV(0) = 1 And i_viv <> 0 Then b_viv1 = Application.Min(DEDV(1), b_viv1) b_viv2 = Application.Min(DEDV(5), b_viv2) X(i1, 17) = b_viv1 * DEDV(2) + b_viv2 * DEDV(6) 'habitatge habitual: ESTAT If i_viv = 1 Then X(i1, 19) = b_viv1 * DEDV(3) + b_viv2 * DEDV(7) 'habitatge habitual: CATALUNYA (general) If i_viv = 2 Then X(i1, 19) = b_viv1 * DEDV(4) + b_viv2 * DEDV(7) 'habitatge habitual: CATALUNYA (especial) X(i1, 17) = Application.Min(X(i1, 17), aux12) 'DEDUCCIÓ HABITATGE HABITUAL: ESTAT X(i1, 19) = Application.Min(X(i1, 19), aux15) 'DEDUCCIÓ HABITATGE HABITUAL: CATALUNYA End If If DED(1) = 1 Then aux12 = Application.Max(0, X(i1, 12) - X(i1, 17)) aux15 = Application.Max(0, X(i1, 15) - X(i1, 19)) X(i1, 18) = Application.Min(p518_529, aux12) 'RESTA DEDUCCIONS s/QIE X(i1, 20) = Application.Min(p520_530, aux15) 'RESTA DEDUCCIONS s/QIA End If If DEDV(8) = 1 Then aux12 = Application.Max(0, X(i1, 12) - X(i1, 17) - X(i1, 18)) aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20)) If p531 > 0 Then X(i1, 17) = X(i1, 17) + Application.Min(p531, aux12) 'DEDUCCIÓ HABITATGE HABITUAL: ESTAT (LLOGUER) If p532 > 0 Then X(i1, 19) = X(i1, 19) + Application.Min(p532, aux15) 'DEDUCCIÓ HABITATGE HABITUAL: CATALUNYA (LLOGUER) End If End If If DEDA1(0, 0) = 1 Then 'Deduccions autonòmiques v917 = 0 'Naixement o adopció v918 = 0 'Donatius entitats llengua catalana v919 = 0 'Donatius entitats innovació científica v920 = 0 'Lloguer habitatge habitual v921 = 0 'Interessos de prèstecs estudis 3er. cicle v922 = 0 'Contribuents vidus o vídues v923 = 0 'Rehabilitació habitatge habitual v924 = 0 'Donacions en benefici del medi ambient v925 = 0 'Inversió en empreses noves o de creació recent(1 o 2) aux = 0 If p917 > 0 Then If cd = 2 Then aux = 150 aux917 = DEDA1(1, 1) Else aux = 300 aux917 = DEDA1(1, 1) * 2 End If v917 = aux * nd3 If v917 <> p917 Then For k1 = 1 To nd3 If aux * (nd3 - k1) = p917 Then v917 = aux917 * (nd3 - k1) GoTo SALTA917 End If Next k1 End If aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20)) v917 = Application.Min(v917, aux15) End If SALTA917: If p918 > 0 Then aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20) - v917) v918 = Application.Min(DEDA1(2, 1) * p918 / 0.15, DEDA1(2, 2) * X(i1, 15), aux15) End If If p919 > 0 Then aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20) - v917 - v918) v919 = Application.Min(DEDA1(3, 1) * p919 / 0.25, DEDA1(3, 2) * X(i1, 15), aux15) End If If p920 > 0 Then aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20) - v917 - v918 - v919) If cd = 1 And _ (ed <= 32 Or dminus = 65) Or (ec <= 32 Or cminus = 65) Or (estciv = 3 And ed = 65) And _ (X(i1, 2) - mpfv(1) <= 30000) Then _ v920 = Application.Min(DEDA1(4, 1) * p920 / DEDA1(4, 1), DEDA1(4, 2) * 2, aux15) If cd = 2 And (ed <= 32 Or dminus = 65) Or (estciv = 3 And ed >= 65) And _ (X(i1, 2) - mpfv(1) <= 20000) Then _ v920 = Application.Min(DEDA1(4, 1) * p920 / DEDA1(4, 1), DEDA1(4, 2), aux15) End If If p921 > 0 Then aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20) - v917 - v918 - v919 - v920) v921 = Application.Min(DEDA1(5, 1) * p921, aux15) End If If p922 > 0 Then aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20) - v917 - v918 - v919 - v920 - v921) If estciv = 3 Then v922 = IIf(i_fills = 0, DEDA1(6, 1), DEDA1(6, 1) * 2) v922 = Application.Min(v922, aux15) End If If p923 > 0 Then aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20) - v917 - v918 - v919 - v920 - v921 - v922) v923 = Application.Min(DEDA1(7, 1) * p923 / 0.015, DEDA1(7, 2), aux15) End If If p924 > 0 Then aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20) - v917 - v918 - v919 - v920 - v921 - v922 - v923) v924 = Application.Min(DEDA1(8, 1) * p924 / 0.15, DEDA1(8, 2) * X(i1, 15), aux15) End If If p925 > 0 Then aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20) - v917 - v918 - v919 - v920 - v921 - v922 - v923 - v924) If p925 <= 6000 Then v925 = Application.Min(DEDA1(9, 1) * p925 / 0.3, DEDA1(9, 2), aux15) If p925 > 6000 Then v925 = Application.Min(DEDA1(10, 1) * p925 / 0.5, DEDA1(10, 2), aux15) End If X(i1, 21) = v917 + v918 + v919 + v920 + v921 + v922 + v923 + v924 + v925 End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' AIXÒ ÉS PER A FER COMPROVACIONS (Deduccions autonòmiques) (només obligats) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' 'IF NOMBRE_DECL="OBLIGATS" THEN ' If i1 = 1 Then ' Open ThisWorkbook.Path & "\COMPROVACIONS\IRPF\ComprovacionsAutonòmiques.txt" For Output As #105 ' Write #105, "p917", "v917", "p918", "v918", "p919", "v919", "p920", "v920", "p921", "v921", "p922", "v922", _ ' "p923", "v923", "p924", "v924", "p925", "v925", "aux15", "p552", "pes" ' End If ' If p917 > 0 Or p918 > 0 Or p919 > 0 Or p920 > 0 Or p921 > 0 Or p922 > 0 Or p923 > 0 Or p924 > 0 Or p925 > 0 Then ' Write #105, p917, v917, p918, v918, p919, v919, p920, v920, p921, v921, p922, v922, p923, v923, p924, v924, p925, v925, aux15, p552, pes ' End If ' If i1 = N1 Then Close #105 'End If If DEDA2(0) = 1 And X(i1, 15) > 0 Then 'Deduccions autonòmiques afegides aux21 = 0 If ed > 65 Then aux21 = aux21 + DEDA2(1) If ed > 75 Then aux21 = aux21 + DEDA2(2) If cd = 1 Then If ec > 65 Then aux21 = aux21 + DEDA2(1) If ec > 75 Then aux21 = aux21 + DEDA2(2) End If If na <> 0 Then aux21 = aux21 + (na * DEDA2(1)) aux21 = aux21 + (na75 * DEDA2(2)) End If If nd <> 0 Then If nd > 2 Then aux21 = aux21 + ((nd - 2) * DEDA2(3) / cd) If nd3 <> 0 Then aux21 = aux21 + (nd3 * DEDA2(4) / cd) If nd > 2 Then aux21 = aux21 + (DEDA2(5) / cd) If nd18_24 <> 0 Then aux21 = aux21 + (DEDA2(6) / cd) End If If DEDA2(7) <> 0 And p920 <> 0 Then aux21 = aux21 + IIf(cd = 1, 2 * DEDA2(7), DEDA2(7)) aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20) - X(i1, 21)) aux21 = Application.Min(aux21, aux15) X(i1, 21) = X(i1, 21) + aux21 End If aux12 = Application.Max(0, X(i1, 12) - X(i1, 17) - X(i1, 18)) aux15 = Application.Max(0, X(i1, 15) - X(i1, 19) - X(i1, 20) - X(i1, 21)) X(i1, 22) = aux12 + p537_541 'increment per deduccions de les que s' ha perdut el dret ESTAT X(i1, 23) = aux15 + p542_546 'increment per deduccions de les que s' ha perdut el dret CCAA If DEDA2(0) = 1 Then If X(i1, 4) <= DEDA2(8) Then 'deducció autonòmica a la quota X(i1, 21) = X(i1, 21) + X(i1, 15) 'Afegeix a les deducciones autonòmiques X(i1,21) X(i1, 15) = 0 'X(i1,15)=0 quota íntegr autonòmica=0 X(i1, 23) = 0 'X(i1,23)=0 quota líquida incrementada autonòmica=0 End If End If X(i1, 24) = X(i1, 22) + X(i1, 23) 'quota líquida total X(i1, 26) = X(i1, 24) 'quota resultant autoliquidació If p553_555 + p556 > 0 And X(i1, 26) > 0 Then X(i1, 25) = Application.Min(p553_555 + p556, X(i1, 26)) 'Deduccions doble imposició i retencions deduïbles X(i1, 26) = X(i1, 26) - X(i1, 25) End If NO_OBLIGATS: If obligado = 0 Then X(i1, 22) = X(i1, 12) X(i1, 23) = X(i1, 15) X(i1, 24) = X(i1, 22) + X(i1, 23) X(i1, 26) = X(i1, 24) End If X(i1, 27) = p571_611 'Maternitat, discapacitat, família nombrosa ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' AIXÒ ÉS PER A FER COMPROVACIONS (Deduccions i quotes líquides) (només obligats) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' 'IF NOMBRE_DECL="OBLIGATS" THEN ' If i1 = 1 Then ' Open ThisWorkbook.Path & "\COMPROVACIONS\IRPF\Comprovacions5.txt" For Output As #105 ' Write #105, "Habit. ESTAT", "Altres ESTAT", "Habit. CCAA", "Altres CCAA", "DED. CCAA", _ ' "Q liq.ESTAT", "Q liq CCAA", "DED d.i.", "q RES", "Matern.", "pes" ' End If ' Write #105, X(i1, 17), X(i1, 19), X(i1, 18), X(i1, 20), X(i1, 21), X(i1, 22), X(i1, 23), X(i1, 25), X(i1, 26), X(i1, 27), pes ' If i1 = N1 Then Close #105 'End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ''''''''''''''''' 'Càlcul pagadors' ''''''''''''''''' X(i1, 28) = X(i1, 26) - X(i1, 27) 'Resultat declaració If X(i1, 28) > 0 Then i_pag = 1 '''''''''''''''''''''''''''''''' 'Càlcul de guanyadors-perdedors' '''''''''''''''''''''''''''''''' If ANOIRPF = IRPF_ANYREF And ANY_PROJ = ANOIRPF Then vgp = p552 - X(i1, 24) X(i1, 30) = 0 X(i1, 32) = 0 If Abs(vgp) > 1 Then If vgp > 0 Then X(i1, 30) = 1 X(i1, 32) = 0 Else X(i1, 30) = 0 X(i1, 32) = 1 End If X(i1, 31) = vgp * X(i1, 30) X(i1, 33) = vgp * X(i1, 32) End If End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' detecció d'errors SAS-SIMCAT (obligats i no obligats) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' 'IF NOMBRE_DECL="OBLIGATS" THEN ' If ii1 = 1 Then ' Open ThisWorkbook.Path & "\COMPROVACIONS\IRPF\ErrorsSIMCAT-SAS.txt" For Output As #150 ' Write #150, "registre", "X(i1, 24)", "p552", "pes" ' End If ' If Abs(p552 - X(i1, 24)) > 1 Then Write #150, registre, X(i1, 24), p552, X(i1, 29) ' If ii1 = N1 + N2 Then Close #150 'End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' 'X(i1, 4) = v435 'En una simulació canvia la BIG per la BIE 'X(i1, 5) = v480 'En una simulació canvia la BLG per la BLE''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If DECL_NOMBRE = "OBLIGATS" Then Call IRPF_6MEMORIA_TRIBUTARIA_CALCULS(opcio2, i1, ed, v435, v491, v492, v917, v918, v919, v920, v921, v922, v923, v924, v925) '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''' 'Determina les variables per al càlcul descriptiu ''''''''''''''''''''''''''''''''''''''''''''''''' For j1 = 1 To 28 If X(i1, j1) <> 0 Then vx(j1, 1) = vx(j1, 1) + (X(i1, j1) * X(i1, 29)) vx(j1, 2) = vx(j1, 2) + (X(i1, j1) * X(i1, 29) * X(i1, 29)) vx(j1, 3) = vx(j1, 3) + (X(i1, j1) * X(i1, j1) * X(i1, 29) * X(i1, 29)) vx(j1, 4) = vx(j1, 4) + 1 vx(j1, 5) = vx(j1, 5) + X(i1, 29) vx(j1, 6) = vx(j1, 6) + (X(i1, 29) * X(i1, 29)) End If Next j1 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Determina les variables per al càlcul dels "no-pagadors" ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' spes2 = spes2 + (X(i1, 29) * X(i1, 29)) vpag(1) = vpag(1) + (i_pag * X(i1, 29)) vpag(2) = vpag(2) + (i_pag * X(i1, 29) * X(i1, 29)) vpag(3) = vpag(3) + (i_pag * X(i1, 29) * X(i1, 29)) NT = NT + X(i1, 29) SALTA_TOTS: Next ii1 Close #1 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If DECL_NOMBRE = "OBLIGATS" Then Call IRPF_6MEMORIA_TRIBUTARIA_TANCA(opcio2) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' For j1 = 1 To 28 SUMA(j1) = vx(j1, 1) MITJANA(j1) = SUMA(j1) / NT Next j1 ' ' ' ' ' ' ' ' ' ' ' ' '' ' Guarda(Descriptiu) a VT' ' ' ' ' ' ' ' ' ' ' ' ' '' VT(1, 0) = "Descriptiu" For j1 = 1 To 28 If vx(j1, 4) <> 0 Then VT(j1, 1) = vx(j1, 1) / vx(j1, 5) VT(j1, 2) = Sqr(vx(j1, 3) - (2 * VT(j1, 1) * vx(j1, 2)) + ((VT(j1, 1) ^ 2) * vx(j1, 6))) / vx(j1, 5) VT(j1, 3) = VT(j1, 1) - 1.96 * VT(j1, 2) VT(j1, 4) = VT(j1, 1) + 1.96 * VT(j1, 2) VT(j1, 5) = vx(j1, 1) / 1000000 VT(j1, 6) = Sqr(vx(j1, 3) - ((vx(j1, 1) ^ 2) / vx(j1, 4))) / 1000000 VT(j1, 7) = VT(j1, 5) - 1.96 * VT(j1, 6) VT(j1, 8) = VT(j1, 5) + 1.96 * VT(j1, 6) End If Next j1 PAG(1) = vpag(1) / NT vpag(4) = (Sqr(vpag(3) - (2 * PAG(1) * vpag(2)) + ((PAG(1) ^ 2) * spes2)) / NT) PAG(2) = PAG(1) - 1.95996 * vpag(4) PAG(3) = PAG(1) + 1.95996 * vpag(4) Call COMUNS_2ORDENA("IRPF") Call IRPF_22DECILS_GP(29) '29 és la posició del pes Call IRPF_24INDEXS(29) '29 és la posició del pes Call IRPF_26DECILS_CLASE(29) '29 és la posició del pes End Sub Private Sub IRPF_22DECILS_GP(pes As Integer) Dim aux, i1 As Long, it As Integer, j1 As Integer ReDim xx_b(1 To N, 1 To 3), xx_p(1 To N) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula: xx_b(1 to N, 1 to 3)=(RTC,BIT,BLT*factor) acumulades / s(variables*factor) ' Calcula: xx_p(1 to N) =població acumulada/NT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For it = 1 To 3 aux = 0 For j1 = 1 To 3 If SUMA(j1) <> 0 Then aux = 0 For i1 = 1 To N aux = aux + (X(IND(i1, it), j1) * X(IND(i1, it), pes)) xx_b(i1, j1) = aux / SUMA(j1) 'it=1 RTC it=2 BIT it=3 BLT Next i1 End If Next j1 aux = 0 For i1 = 1 To N aux = aux + X(IND(i1, it), pes) xx_p(i1) = aux / NT 'pes Next i1 If it < 3 Then Call IRPF_23DECILS(it, pes, xx_b, xx_p) 'DECILS Next it If ANOIRPF = IRPF_ANYREF And ANY_PROJ = ANOIRPF Then Call IRPF_25GP(pes) 'G-P End Sub Private Sub IRPF_23DECILS(it, pes, xx_b, xx_p) Dim aux, i1 As Long, i2 As Long, j1 As Integer, k1 As Integer, l1 As Long ReDim ds(56, 12), p(1 To 12, 2), ts(24, 12), xx_r(1 To N, 1 To pes - 4) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula: xx_r(1 to N, 1 to pes-4)=(resta * factor) acumulades / s(variables * factor) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' aux = 0 For j1 = 1 To pes - 4 If SUMA(j1 + 3) <> 0 Then aux = 0 For i1 = 1 To N aux = aux + (X(IND(i1, it), j1 + 3) * X(IND(i1, it), pes)) xx_r(i1, j1) = aux / SUMA(j1 + 3) 'resta variables Next i1 End If Next j1 For k1 = 1 To 12 p(k1, 1) = IIf(k1 < 10, k1 / 10, IIf(k1 = 10, 0.95, IIf(k1 = 11, 0.98, 1))) p(k1, 2) = IIf(k1 < 10, 0.1, IIf(k1 = 10, 0.05, IIf(k1 = 11, 0.03, 0.02))) Next k1 i2 = 1 For k1 = 1 To 11 For i1 = i2 To N If xx_p(i1) >= p(k1, 1) Then p(k1, 0) = i1 'p(1 to 12, 0 = Observació on comença cada decil i2 = i1 Exit For End If Next i1 Next k1 p(12, 0) = N ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Càlcul DECILS (1a dimensió parell decil acumulat) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' VT(45 o 125,1 to 12)=Base imposable general ( 3)=ds( 7, 1 to 12)' ' VT(47 o 127,1 to 12)=Base liquidable general ( 5)=ds( 9, 1 to 12)' ' VT(48 o 129,1 to 12)=Reduccions plans pensions ( 6)=ds(11, 1 to 12)' ' VT(51 o 131,1 to 12)=Reducció tributació conjunta ( 7)=ds(13, 1 to 12)' ' VT(53 o 133,1 to 12)=Minim personal i familiar ( 8)=ds(15, 1 to 12)' ' VT(55 o 135,1 to 12)=Quota deduïda per MPF ( 9)=ds(17, 1 to 12)' ' VT(57 o 137,1 to 12)=Quota ESTAT base general (10)=ds(19, 1 to 12)' ' VT(59 o 139,1 to 12)=Quota ESTAT base estalvi (11)=ds(21, 1 to 12)' ' VT(61 o 141,1 to 12)=Quota íntegra ESTAT (12)=ds(23, 1 to 12)' ' VT(63 o 143,1 to 12)=Quota CCAA base general (13)=ds(25, 1 to 12)' ' VT(65 o 145,1 to 12)=Quota CCAA base estalvi (14)=ds(27, 1 to 12)' ' VT(67 o 147,1 to 12)=Quota íntegra CCAA (15)=ds(29, 1 to 12)' ' VT(69 o 149,1 to 12)=Quota íntegra total (16)=ds(31, 1 to 12)' ' VT(71 o 151,1 to 12)=deducció habitatge habitual S/QIE (17)=ds(33, 1 to 12)' ' VT(73 o 153,1 to 12)=resta deduccions s/QIE (18)=ds(35, 1 to 12)' ' VT(75 o 155,1 to 12)=deducció habitatge habitual S/QIA (19)=ds(37, 1 to 12)' ' VT(77 o 157,1 to 12)=resta deduccions s/QIA (20)=ds(39, 1 to 12)' ' VT(79 o 159,1 to 12)=altres deduccions CCAA s/QIA (21)=ds(41, 1 to 12)' ' VT(81 o 161,1 to 12)=Quota líquida incrementada ESTAT (22)=ds(43, 1 to 12)' ' VT(83 o 163,1 to 12)=Quota líquida incrementada CATALUNYA (23)=ds(45, 1 to 12)' ' VT(85 o 165,1 to 12)=Quota líquida incrementada total (24)=ds(47, 1 to 12)' ' VT(87 o 167,1 to 12)=Deduccions doble imposició i compensacions (25)=ds(49, 1 to 12)' ' VT(89 o 169,1 to 12)=Quota reultant autoliquidació (26)=ds(51, 1 to 12)' ' VT(91 o 171,1 to 12)=Deduccions maternitat i naixement (27)=ds(53, 1 to 12)' ' VT(93 o 173,1 to 12)=Resultat declaració (28)=ds(55, 1 to 12)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For k1 = 1 To 12 l1 = p(k1, 0) For j1 = 1 To 3 ds(2 * j1, k1) = xx_b(l1, j1) 'RTC, BIT, BLT If k1 = 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) If k1 > 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) - ds(2 * j1, k1 - 1) Next j1 For j1 = 4 To pes - 1 ds(2 * j1, k1) = xx_r(l1, j1 - 3) 'resta If k1 = 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) If k1 > 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) - ds(2 * j1, k1 - 1) Next j1 Next k1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' Càlcul tipus efectius ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' VT(95 o 175,1 to 12)= QIE s/ RTC (23/1)=ts( 1, 1 to 12)' ' VT(96 o 176,1 to 12)= QIA s/ RTC (29/1)=ts( 2, 1 to 12)' ' VT(97 o 177,1 to 12)= QIT s/ RTC (31/1)=ts( 3, 1 to 12)' ' VT(98 o 178,1 to 12)= QIE s/ BIT (23/3)=ts( 4, 1 to 12)' ' VT(99 o 179,1 to 12)= QIA s/ BIT (29/3)=ts( 5, 1 to 12)' ' VT(100 o 180,1 to 12)= QIT s/ BIT (31/3)=ts( 6, 1 to 12)' ' VT(101 o 181,1 to 12)= QIE s/ BLT (23/5)=ts( 7, 1 to 12)' ' VT(102 o 182,1 to 12)= QIA s/ BLT (29/5)=ts( 8, 1 to 12)' ' VT(103 o 183,1 to 12)= QIT s/ BLT (31/5)=ts( 9, 1 to 12)' ' VT(104 o 184,1 to 12)= QLE s/ RTC (43/1)=ts(10, 1 to 12)' ' VT(105 o 185,1 to 12)= QLA s/ RTC (45/1)=ts(11, 1 to 12)' ' VT(106 o 186,1 to 12)= QLT s/ RTC (47/1)=ts(12, 1 to 12)' ' VT(107 o 187,1 to 12)= QRA s/ RTC (51/1)=ts(13, 1 to 12)' ' VT(108 o 188,1 to 12)= RD s/ RTC (55/1)=ts(14, 1 to 12)' ' VT(109 o 189,1 to 12)= QLE s/ BIT (43/3)=ts(15, 1 to 12)' ' VT(110 o 190,1 to 12)= QLA s/ BIT (45/3)=ts(16, 1 to 12)' ' VT(111 o 191,1 to 12)= QLT s/ BIT (47/3)=ts(17, 1 to 12)' ' VT(112 o 192,1 to 12)= QRA s/ BIT (51/3)=ts(18, 1 to 12)' ' VT(113 o 193,1 to 12)= RD s/ BIT (55/3)=ts(19, 1 to 12)' ' VT(114 o 194,1 to 12)= QLE s/ BLT (43/5)=ts(20, 1 to 12)' ' VT(115 o 195,1 to 12)= QLA s/ BLT (45/5)=ts(21, 1 to 12)' ' VT(116 o 196,1 to 12)= QLT s/ BLT (47/5)=ts(22, 1 to 12)' ' VT(117 o 197,1 to 12)= QRA s/ BLT (51/5)=ts(23, 1 to 12)' ' VT(118 o 198,1 to 12)= RD s/ BLT (55/5)=ts(24, 1 to 12)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ts( 1, 1 to 12) = (ds((23, 1 to 12) * SUMA(12)) / (ds((1, 1 to 12) * SUMA(1))' ' ts(24, 1 to 12) = (ds((55, 1 to 12) * SUMA(28)) / (ds((5, 1 to 12) * SUMA(3))' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' For k1 = 1 To 12 If SUMA(1) <> 0 And ds(1, k1) <> 0 Then ts(1, k1) = (ds(23, k1) * SUMA(12)) / (ds(1, k1) * SUMA(1)) ts(2, k1) = (ds(29, k1) * SUMA(15)) / (ds(1, k1) * SUMA(1)) ts(3, k1) = (ds(31, k1) * SUMA(16)) / (ds(1, k1) * SUMA(1)) ts(10, k1) = (ds(43, k1) * SUMA(22)) / (ds(1, k1) * SUMA(1)) ts(11, k1) = (ds(45, k1) * SUMA(23)) / (ds(1, k1) * SUMA(1)) ts(12, k1) = (ds(47, k1) * SUMA(24)) / (ds(1, k1) * SUMA(1)) ts(13, k1) = (ds(51, k1) * SUMA(26)) / (ds(1, k1) * SUMA(1)) ts(14, k1) = (ds(55, k1) * SUMA(28)) / (ds(1, k1) * SUMA(1)) End If If SUMA(2) <> 0 And ds(3, k1) <> 0 Then ts(4, k1) = (ds(23, k1) * SUMA(12)) / (ds(3, k1) * SUMA(2)) ts(5, k1) = (ds(29, k1) * SUMA(15)) / (ds(3, k1) * SUMA(2)) ts(6, k1) = (ds(31, k1) * SUMA(16)) / (ds(3, k1) * SUMA(2)) ts(15, k1) = (ds(43, k1) * SUMA(22)) / (ds(3, k1) * SUMA(2)) ts(16, k1) = (ds(45, k1) * SUMA(23)) / (ds(3, k1) * SUMA(2)) ts(17, k1) = (ds(47, k1) * SUMA(24)) / (ds(3, k1) * SUMA(2)) ts(18, k1) = (ds(51, k1) * SUMA(26)) / (ds(3, k1) * SUMA(2)) ts(19, k1) = (ds(55, k1) * SUMA(28)) / (ds(3, k1) * SUMA(2)) End If If SUMA(3) <> 0 And ds(5, k1) <> 0 Then ts(7, k1) = (ds(23, k1) * SUMA(12)) / (ds(5, k1) * SUMA(3)) ts(8, k1) = (ds(29, k1) * SUMA(15)) / (ds(5, k1) * SUMA(3)) ts(9, k1) = (ds(31, k1) * SUMA(16)) / (ds(5, k1) * SUMA(3)) ts(20, k1) = (ds(43, k1) * SUMA(22)) / (ds(5, k1) * SUMA(3)) ts(21, k1) = (ds(45, k1) * SUMA(23)) / (ds(5, k1) * SUMA(3)) ts(22, k1) = (ds(47, k1) * SUMA(24)) / (ds(5, k1) * SUMA(3)) ts(23, k1) = (ds(51, k1) * SUMA(26)) / (ds(5, k1) * SUMA(3)) ts(24, k1) = (ds(55, k1) * SUMA(28)) / (ds(5, k1) * SUMA(3)) End If Next k1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda límits i mitjanes, decils i tipus a VT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' VT(IIf(it = 1, 29, 31), 0) = "Límits i mitjanes " & IIf(it = 1, "RTC", "BIT") For k1 = 1 To 12 VT(IIf(it = 1, 29, 31), k1) = (X(IND(p(k1, 0), it), it)) / 1000 VT(IIf(it = 1, 30, 32), k1) = (ds(IIf(it = 1, 1, 3), k1) * SUMA(it) / (NT * IIf(k1 < 10, 0.1, IIf(k1 = 10, 0.05, IIf(k1 = 11, 0.03, 0.02))))) / 1000 Next k1 VT(IIf(it = 1, 39, 119), 0) = "Decils-" & IIf(it = 1, "RTC", "BIT") For k1 = 1 To 12 For j1 = 1 To 56 VT(IIf(it = 1, 38, 118) + j1, k1) = ds(j1, k1) Next j1 Next k1 VT(IIf(it = 1, 95, 175), 0) = "Tipus-" & IIf(it = 1, "RTC", "BIT") For k1 = 1 To 12 For j1 = 1 To 24 VT(IIf(it = 1, 94, 174) + j1, k1) = ts(j1, k1) Next j1 Next k1 End Sub Private Sub IRPF_24INDEXS(pes) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' INDEXS 55 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Gini: g 3 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Concentració: c 19 ' Kakwani: k 19 ' Suits: s 19 ' Efecte Redistributiu: e 19 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim aconc As Double, aefre As Double, agini As Double, asuit As Double, aux As Double, _ i1 As Long, it As Integer, j1 As Integer, k1 As Integer, l1 As Integer, sxx_b As Double Dim i(1 To 19) As Integer, g As Double ReDim c(1 To 19) As Double, k(1 To 19) As Double, s(1 To 19) As Double, e(1 To 19) As Double, _ daux(1 To 4) As Double, suma0(1 To pes) As Double, mitjana0(1 To pes) As Double, xx(1 To N, 1 To pes) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Identifica les variables per a les que calcula els índexs ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' i(1) = 6 i(2) = 7 i(3) = 8 i(4) = 9 i(5) = 12 i(6) = 15 i(7) = 16 i(8) = 17 i(9) = 18 i(10) = 19 i(11) = 20 i(12) = 21 i(13) = 22 i(14) = 23 i(15) = 24 i(16) = 25 i(17) = 26 i(18) = 27 i(19) = 28 For j1 = 1 To pes - 1 For i1 = 1 To N If X(i1, j1) > 0 Then suma0(j1) = suma0(j1) + (X(i1, j1) * X(i1, pes)) Next i1 mitjana0(j1) = suma0(j1) / NT Next j1 For it = 1 To 3 agini = 0 sxx_b = 0 aux = 0 For i1 = 1 To N aux = aux + X(IND(i1, it), pes) xx(i1, pes) = aux / NT 'pes Next i1 aux = 0 For j1 = 1 To pes - 1 If suma0(j1) <> 0 Then aux = 0 For i1 = 1 To N If X(IND(i1, it), j1) > 0 Then aux = aux + (X(IND(i1, it), j1) * X(IND(i1, it), pes)) Else aux = aux + 0 xx(i1, j1) = aux / suma0(j1) Next i1 End If Next j1 If suma0(it) <> 0 Then For i1 = 1 To N If X(IND(i1, it), it) > 0 Then daux(1) = X(IND(i1, it), it) - mitjana0(it) Else daux(1) = 0 - mitjana0(it) daux(2) = xx(i1, pes) - (NT / N) daux(3) = X(IND(i1, it), pes) agini = agini + (daux(1) * daux(2) * daux(3)) sxx_b = sxx_b + xx(i1, it) 's.acum. RTC,BIT,BLT Next i1 If agini <> 0 Then g = 2 / mitjana0(it) * (agini / NT) 'gini End If For j1 = 1 To 19 aconc = 0 aefre = 0 asuit = 0 If suma0(i(j1)) <> 0 Then For i1 = 1 To N If X(IND(i1, it), i(j1)) > 0 Then daux(1) = X(IND(i1, it), i(j1)) - mitjana0(i(j1)) Else daux(1) = 0 - mitjana0(i(j1)) daux(2) = xx(i1, pes) - (NT / N) daux(3) = X(IND(i1, it), pes) daux(4) = xx(i1, it) - (sxx_b / N) aconc = aconc + (daux(1) * daux(2) * daux(3)) asuit = asuit + (daux(1) * daux(4) * daux(3)) Next i1 If aconc <> 0 Then c(j1) = 2 / mitjana0(i(j1)) * (aconc / NT) 'concentració k(j1) = c(j1) - g 'kakwani s(j1) = (2 * (asuit / NT) / mitjana0(i(j1))) - g 'suits If suma0(it) <> 0 Then aefre = suma0(i(j1)) / suma0(it) e(j1) = (aefre / (1 - aefre)) * k(j1) 'ef red. End If Next j1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' Guarda els resultats(Índexs) a VT' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' If it = 1 Then VT(199, 0) = "Índexs" VT(198 + it) = g 'gini For j1 = 1 To 19 VT(201 + j1, it) = c(j1) 'Concentració VT(201 + j1, it + 3) = k(j1) 'Kakwani VT(201 + j1, it + 6) = s(j1) 'Suits VT(201 + j1, it + 9) = e(j1) 'Efecte Redistributiu Next j1 Next it End Sub Private Sub IRPF_25GP(pes) Dim aux, i1 As Long, i2 As Long, j1 As Integer, k1 As Integer ReDim GP(1 To 6, 1 To 12), p(1 To 12, 2), xx_gp(1 To N, 1 To 4), _ xx_p(1 To N), y(4, 12) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula: xx_gp(1 to N, pes + 1 to pes + 4) = (GP * factor) acumulades ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' aux = 0 For j1 = pes + 1 To pes + 4 aux = 0 For i1 = 1 To N aux = aux + (X(IND(i1, 1), j1) * X(IND(i1, 1), pes)) xx_gp(i1, j1 - pes) = aux Next i1 Next j1 aux = 0 For i1 = 1 To N aux = aux + X(IND(i1, 1), pes) xx_p(i1) = aux / NT Next i1 For k1 = 1 To 12 p(k1, 1) = IIf(k1 < 10, k1 / 10, IIf(k1 = 10, 0.95, IIf(k1 = 11, 0.98, 1))) p(k1, 2) = IIf(k1 < 10, 0.1, IIf(k1 = 10, 0.05, IIf(k1 = 11, 0.03, 0.02))) Next k1 i2 = 1 For k1 = 1 To 11 For i1 = i2 To N If xx_p(i1) >= p(k1, 1) Then p(k1, 0) = i1 ' p(1 to 12, 0 = Observació on comença cada decil i2 = i1 Exit For End If Next i1 Next k1 p(12, 0) = N For k1 = 1 To 12 i1 = p(k1, 0) For j1 = 1 To 4 y(j1, k1) = xx_gp(i1, j1) Next j1 Next k1 For k1 = 1 To 12 GP(1, k1) = y(1, k1) - y(1, k1 - 1) GP(2, k1) = y(2, k1) - y(2, k1 - 1) If GP(1, k1) <> 0 Then GP(3, k1) = GP(2, k1) / Round(GP(1, k1), 0) 'guanys per capita GP(4, k1) = y(3, k1) - y(3, k1 - 1) GP(5, k1) = y(4, k1) - y(4, k1 - 1) If GP(4, k1) <> 0 Then GP(6, k1) = GP(5, k1) / Round(GP(4, k1), 0) 'pèrdues per capita GP(1, k1) = GP(1, k1) / (p(k1, 2) * NT) '%guanyadors GP(2, k1) = GP(2, k1) / 1000 'guanys GP(4, k1) = GP(4, k1) / (p(k1, 2) * NT) '%perdedors GP(5, k1) = GP(5, k1) / 1000 'pèrdues Next k1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda(Guanyadors) a VT) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' VT(31, 0) = "Guanyadors" For k1 = 1 To 12 For j1 = 1 To 6 VT(j1 + 32, k1) = IIf(j1 = 4, -1, 1) * GP(j1, k1) Next j1 Next k1 End Sub Private Sub IRPF_26DECILS_CLASE(pes) Dim auxx, ix(1 To 18) As Integer, i1 As Long, i2 As Long, j1 As Integer, k1 As Integer, _ l1 As Integer, l2 As Integer, m1 As Integer, N1, N2 As Double ReDim aux(1 To 2), dc(1 To 18, 1 To 4, 10), p(10), _ xx(1 To N) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Selecciona les variables ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ix(1) = pes ix(2) = 1 ix(3) = 6 ix(4) = 7 ix(5) = 8 ix(6) = 9 ix(7) = 12 ix(8) = 15 ix(9) = 16 ix(10) = 17 ix(11) = 18 ix(12) = 19 ix(13) = 20 ix(14) = 21 ix(15) = 22 ix(16) = 23 ix(17) = 24 ix(18) = 28 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula xx(1 to N, 1 to 14)=(variables * factor) acumulades / suma(variables * factor)' ' xx(1 to N, 15) = població acumulada/NT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For i1 = 1 To N aux(1) = aux(1) + X(IND(i1, 1), pes) xx(i1) = aux(1) / NT Next i1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' p(1 to 10) = Observació on comença cada decil' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' p(0) = 1 i2 = 1 For j1 = 1 To 9 For i1 = i2 To N If xx(i1) >= j1 / 10 Then p(j1) = i1 i2 = i1 + 1 Exit For End If Next i1 Next j1 p(10) = N ' ' ' ' ' ' ' ' ' DECILS' ' ' ' ' ' ' ' ' For l1 = 1 To 18 m1 = ix(l1) For j1 = 0 To 9 For i1 = p(j1) + IIf(j1 = 0, 0, 1) To p(j1 + 1) N1 = X(IND(i1, 1), m1) N2 = X(IND(i1, 1), pes) For k1 = 1 To 4 If CATEG(IND(i1, 1)) = k1 Then If l1 = 1 Then dc(l1, k1, j1 + 1) = dc(l1, k1, j1 + 1) + N2 / NT Else If SUMA(m1) <> 0 Then dc(l1, k1, j1 + 1) = dc(l1, k1, j1 + 1) + (N1 * N2 / SUMA(m1)) Else dc(l1, k1, j1 + 1) = 0 End If End If End If Next k1 Next i1 Next j1 Next l1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda(DECILS) a VT)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' VT(278, 0) = "Decils" ' 212 For l1 = 1 To 18 For k1 = 1 To 4 For j1 = 1 To 10 If k1 = 1 Then VT(278 + (18 * (k1 - 1)), 1) = "Jubilats" If k1 = 2 Then VT(278 + (18 * (k1 - 1)), 1) = "Assalari" If k1 = 3 Then VT(278 + (18 * (k1 - 1)), 1) = "Empresar" If k1 = 4 Then VT(278 + (18 * (k1 - 1)), 1) = "No class." VT(277 + l1 + (18 * (k1 - 1)), j1 + 1) = dc(l1, k1, j1) Next j1 Next k1 Next l1 End Sub Private Sub IRPF_30COMPARACIO(avis As Boolean) Dim aux, i1 As Long, it As Integer, j1 As Integer, k1 As Integer, ds(), GP() ReDim a(1 To 12) Open NOM_IRPF_SIMUL & "GP" & ANOIRPF & "_" & Trim(Str(COMP(1))) & ".dat" For Input As #1 Open NOM_IRPF_SIMUL & "GP" & ANOIRPF & "_" & Trim(Str(COMP(2))) & ".dat" For Input As #2 Input #1, N, a(1), a(2) Input #1, a(5), a(6), a(7), a(8), a(9), a(10), a(11), a(12) 'Segona línia de noms Input #2, N, a(3), a(4) Input #2, a(5), a(6), a(7), a(8), a(9), a(10), a(11), a(12) 'Segona línia de noms If a(1) = a(3) And a(2) = a(4) Then ReDim X(1 To N, 1 To 7), IND(1 To N, 1 To 2) For i1 = 1 To N IND(i1, 1) = i1 Input #1, a(5), a(6), a(7), a(8), a(9), X(i1, 1), X(i1, 7), IND(i1, 2) Input #2, a(5), a(6), a(7), a(8), a(9), X(i1, 2), a(10), a(11) Next i1 Close #1 Close #2 For it = 1 To 2 ' it=1 ordre RTC it=2 ordre BIT ReDim s(1 To 7) As Double For i1 = 1 To N aux = X(IND(i1, it), 1) - X(IND(i1, it), 2) X(IND(i1, it), 3) = 0 X(IND(i1, it), 5) = 0 If Abs(aux) > 1 Then If aux > 0 Then X(IND(i1, it), 3) = 1 X(IND(i1, it), 5) = 0 Else X(IND(i1, it), 3) = 0 X(IND(i1, it), 5) = 1 End If X(IND(i1, it), 4) = aux * X(IND(i1, it), 3) X(IND(i1, it), 6) = aux * X(IND(i1, it), 5) End If For j1 = 1 To 6 s(j1) = s(j1) + (X(IND(i1, it), j1) * X(IND(i1, it), 7)) Next j1 s(7) = s(7) + X(i1, 7) Next i1 Call IRPF_31COMPARACIO_DECILS_GP(it, ds, GP, s) Call IRPF_32COMPARACIO_ESCRIPTURA(it, a(1), a(2), ds, GP, s) Next it Call COMUNS_5IMPRESSIO("IRPF", "G-P") Else avis = True ERR_LEC = True Inicial.Hide If a(1) <> a(3) Then MsgBox "Las simulaciones que se quieren comparar corresponden a diferente número de declarantes.", vbCritical, TITOL_IRPF End If If a(2) <> a(4) Then MsgBox "Las simulacions que se quieren comparar corresponden a diferente año de proyección.", vbCritical, TITOL_IRPF End If Close #1 Close #2 Exit Sub End If End Sub Private Sub IRPF_31COMPARACIO_DECILS_GP(it, ds, GP, s) Dim aux, i1 As Long, i2 As Long, j1 As Integer, k1 As Integer, l1 As Long ReDim p(1 To 12, 2), ds(1 To 4, 1 To 12), GP(1 To 8, 1 To 12), xx(1 To N, 1 To 7), y(4, 12) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula xx(1 to N, 1 to 6)=(variables * factor) acumulades / s(variables * factor) ' xx(1 to N, 7) = població acumulada/s(7) s(7)=NT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To 6 aux = 0 If s(j1) <> 0 Then For i1 = 1 To N aux = aux + (X(IND(i1, it), j1) * X(IND(i1, it), 7)) xx(i1, j1) = aux / IIf(j1 <= 2, s(j1), 1) Next i1 End If Next j1 aux = 0 For i1 = 1 To N aux = aux + X(IND(i1, it), 7) xx(i1, 7) = aux / s(7) Next i1 For j1 = 1 To 12 p(j1, 1) = IIf(j1 < 10, j1 / 10, IIf(j1 = 10, 0.95, IIf(j1 = 11, 0.98, 1))) p(j1, 2) = IIf(j1 < 10, 0.1, IIf(j1 = 10, 0.05, IIf(j1 = 11, 0.03, 0.02))) Next j1 i2 = 1 For j1 = 1 To 11 For i1 = i2 To N If xx(i1, 7) >= p(j1, 1) Then p(j1, 0) = i1 ' p(1 to 12, 0 = Observació on comença cada decil i2 = i1 Exit For End If Next i1 Next j1 p(12, 0) = N ' ' ' ' ' ' ' ' ' DECILS' ' ' ' ' ' ' ' ' For k1 = 1 To 12 l1 = p(k1, 0) For j1 = 1 To 2 ds(2 * j1, k1) = xx(l1, j1) If k1 = 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) If k1 > 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) - ds(2 * j1, k1 - 1) Next j1 Next k1 ' ' ' ' ' ' ' ' ' ' ' ' ' GUANYADORS-PERDEDORS' ' ' ' ' ' ' ' ' ' ' ' ' For k1 = 1 To 12 l1 = p(k1, 0) For j1 = 1 To 4 y(j1, k1) = xx(l1, j1 + 2) Next j1 Next k1 For k1 = 1 To 12 For j1 = 1 To 8 GP(j1, k1) = 0 Next j1 GP(1, k1) = (y(1, k1) - y(1, k1 - 1)) / (p(k1, 2) * s(7)) '%guanyadors GP(2, k1) = Round(y(1, k1) - y(1, k1 - 1), 0) 'guanyadors totals GP(3, k1) = (y(2, k1) - y(2, k1 - 1)) / 1000 'guanys totals If GP(2, k1) <> 0 Then GP(4, k1) = GP(3, k1) * 1000 / GP(2, k1) 'guanys per capita GP(5, k1) = (y(3, k1) - y(3, k1 - 1)) / (p(k1, 2) * s(7)) '%perdedors GP(6, k1) = Round(y(3, k1) - y(3, k1 - 1), 0) 'perdedors totals GP(7, k1) = (y(4, k1) - y(4, k1 - 1)) / 1000 'pèrdues totals If GP(6, k1) <> 0 Then GP(8, k1) = GP(7, k1) * 1000 / GP(6, k1) 'pèrdues per capita Next k1 For k1 = 1 To 12 GP(5, k1) = -GP(5, k1) 'Pel gràfic Next k1 End Sub Private Sub IRPF_32COMPARACIO_ESCRIPTURA(it, declarants, anyproj, ds, GP, s) Dim avisgp As Boolean, nom As String, fila As Integer, i1 As Integer, llibre As Integer, nota As String, r_f(1 To 2, 1 To 3) As Range ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1 to 2, 1)==> formats del llibre "FORMATS", full "IRPF" ' ' r_f(1 to 2, 2)==> formats del llibre "SIMCAN", full "(G-P)" ' ' r_f(1 to 2, 3)==> formats del llibre "SIMCAN", full "(G-P)" (només valors)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Application.ScreenUpdating = False nom = ThisWorkbook.Path & "\DADES\Formats.XLSX" Set LLIBRE_FORMATS = Workbooks.Open(nom) llibre = Workbooks.Count Workbooks(llibre).Activate ' llibre "FORMATS" Sheets("IRPF").Activate Set r_f(1, 1) = Range(Cells(450, 1), Cells(458, 15)) ' Decils Set r_f(2, 1) = Range(Cells(460, 1), Cells(469, 15)) ' Guanyadors ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Crea el full de càlcul on escriu els resultats definitius' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' fila = (it - 1) * 67 + 1 ThisWorkbook.Activate ' llibre "SIMCAN" If it = 1 Then Call COMUNS_0NOMSFULLS("IRPF(G-P)") ActiveWorkbook.Unprotect (SECRET) End If ActiveWorkbook.Unprotect (SECRET) Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate Sheets("IRPF(G-P)").Activate ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Configura el rang d' escriptura' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' With Range(Cells(fila, 1), Cells(fila + 66, 15)) .ColumnWidth = 6.43 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 11 End With With Range(Cells(fila, 1), Cells(fila + 1, 1)) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 End With Cells(fila, 1).Value = "IMPUESTO DE LA RENTA DE LAS PERSONAS FÍSICAS" Cells(fila + 1, 1).Value = "COMPARACIÓN SIMULACIÓN-" & COMP(1) & " vs. SIMULACIÓN-" & COMP(2) & _ " (Base de datos: " & ANOIRPF & _ IIf(anyproj <> ANOIRPF, " proyectada al " & ANY_PROJ, "") & _ IIf(declarants = "TOTS", ", Total declarantes", ", Solo declarantes obligados") & ")" Set r_f(1, 2) = Range(Cells(fila + 2, 1), Cells(fila + 10, 15)) ' Decils Rangs d' escriptura Set r_f(2, 2) = Range(Cells(fila + 12, 1), Cells(fila + 21, 15)) ' Guanyadors Rangs d' escriptura Set r_f(1, 3) = Range(Cells(fila + 5, 4), Cells(fila + 8, 15)) ' Decils Rangs de valors Set r_f(2, 3) = Range(Cells(fila + 14, 4), Cells(fila + 21, 15)) ' Guanyadors Rangs de valors ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriu els resultats numèrics' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1, 1).Copy Destination:=r_f(1, 2) r_f(1, 2).Rows(1).Columns(1).Value = Cells(fila + 2, 1) & IIf(it = 1, " RTC)", " BIT)") r_f(1, 2).Rows(4).Columns(1).Value = "RD SIMULACIÓN-" & COMP(1) r_f(1, 2).Rows(6).Columns(1).Value = "RD SIMULACIÓN-" & COMP(2) r_f(1, 2).Rows(8).Columns(1).Value = "SIMULACIÓN-" & COMP(1) r_f(1, 2).Rows(9).Columns(1).Value = "SIMULACIÓN-" & COMP(2) r_f(1, 2).Rows(8).Columns(3).Value = s(1) / 1000000 r_f(1, 2).Rows(9).Columns(3).Value = s(2) / 1000000 r_f(1, 2).Rows(9).Columns(6).Value = s(3) r_f(1, 2).Rows(9).Columns(8).Value = s(5) If s(1) = s(2) Then nota = "Simulaciones neutrales" ElseIf s(1) > s(2) Then nota = "Pérdida de recaudación" Else nota = "Ganancia de recaudación" End If r_f(1, 2).Rows(8).Columns(11).Value = nota If nota <> "Simulaciones neutrales" Then r_f(1, 2).Rows(9).Columns(11).Value = (s(2) - s(1)) / 1000000 Else With Range(Cells(fila + 9, 11), Cells(fila + 10, 13)) .Interior.Pattern = xlCrissCross .MergeCells = True .Value = nota End With End If r_f(1, 2).Rows(9).Columns(15).Value = s(7) r_f(2, 1).Copy Destination:=r_f(2, 2) r_f(2, 2).Rows(1).Columns(1).Value = Cells(fila + 12, 1) & IIf(it = 1, " RTC)", " BIT)") r_f(1, 3).Value = ds r_f(2, 3).Value = GP r_f(2, 3).ShrinkToFit = True LLIBRE_FORMATS.Close ' ' ' ' ' ' ' ' ' ' ' ' ' ' Gràfics G-P' ' ' ' ' ' ' ' ' ' ' ' ' ' For i1 = 1 To 12 If Abs(r_f(2, 3).Rows(1).Columns(i1)) > 0.001 Or Abs(r_f(2, 3).Rows(5).Columns(i1)) > 0.001 Then avisgp = True Exit For End If Next i1 If avisgp Then Dim r_gp(1 To 2, 1 To 4) As Range Set r_gp(1, 1) = r_f(1, 3).Rows(1) ' Quota Simulació-1' Set r_gp(2, 1) = r_f(1, 3).Rows(3) ' Quota Simulació-2' Set r_gp(1, 2) = r_f(2, 3).Rows(1) ' % guanyadors' Set r_gp(2, 2) = r_f(2, 3).Rows(5) ' % perdedors' Set r_gp(1, 3) = r_f(2, 3).Rows(3) ' Total guanys' Set r_gp(2, 3) = r_f(2, 3).Rows(7) ' Total pèrdues' Set r_gp(1, 4) = r_f(2, 3).Rows(4) ' guanyadors per capita' Set r_gp(2, 4) = r_f(2, 3).Rows(8) ' perdedors per capita' r_gp(2, 2).NumberFormat = "0.00%;[Red]0.00%" Call COMUNS_43GRAFICS_GP(23 + fila, ANOIRPF, "IRPF", "(G-P)", r_gp, 1) For i1 = 1 To Worksheets("IRPF(G-P)").Shapes.Count Worksheets("IRPF(G-P)").Shapes(i1).Left = IIf(i1 = 1 Or i1 = 3 Or i1 = 5 Or i1 = 7, 10, 280) ' Reposicionament imatges Next i1 End If ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 67, 1)) If it > 1 Then ActiveSheet.Protect (SECRET) End Sub Private Sub IRPF_40ESCRIPTURA(opcio) Dim fila As Integer, GP As Boolean, i As Integer, i1 As Integer, j1 As Integer, _ llibre(1 To 2) As Integer, nom As String, _ r_ref(1 To 4) As Range, r_f(1 To 10, 1 To 4) As Range, r_parms(1 To 2) As Range, _ r_gp(1 To 2, 1 To 4) As Range ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1 to 9, 1) ==> formats del llibre "FORMATS", full "IRPF" ' ' r_f(1 to 9, 2) ==> formats del llibre "RESULTATS" temporals ' ' r_f(1 to 9, 3) ==> formats del llibre "SIMCAN", full "IRPF(R)" ' ' r_f(1 to 9, 4) ==> formats del llibre "SIMCAN", full "IRPF(R)" (només valors)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Application.ScreenUpdating = False nom = ThisWorkbook.Path & "\DADES\Formats.XLSX" Set LLIBRE_FORMATS = Workbooks.Open(nom) llibre(1) = Workbooks.Count Workbooks(llibre(1)).Activate ' llibre "FORMATS" Sheets("IRPF").Activate Set r_parms(1) = Range(Cells(2, 1), Cells(51, 15)) ' Paràmetres Set r_f(1, 1) = Range(Cells(53, 1), Cells(85, 15)) ' Descriptiu Set r_f(2, 1) = Range(Cells(87, 1), Cells(92, 15)) ' Límits i mitjanes per decils Set r_f(3, 1) = Range(Cells(94, 1), Cells(101, 15)) ' Guanyadors-Perdedors Set r_f(4, 1) = Range(Cells(103, 1), Cells(161, 15)) ' Decils(RTC) Set r_f(5, 1) = Range(Cells(163, 1), Cells(188, 15)) ' Tipus (RTC) Set r_f(6, 1) = Range(Cells(103, 1), Cells(161, 15)) ' Decils(BIT) Set r_f(7, 1) = Range(Cells(163, 1), Cells(188, 15)) ' Tipus (BIT) Set r_f(8, 1) = Range(Cells(190, 1), Cells(194, 4)) ' Indexs (Gini) Set r_f(9, 1) = Range(Cells(196, 1), Cells(217, 15)) ' Indexs (Resta) Set r_f(10, 1) = Range(Cells(219, 1), Cells(292, 15)) ' Decils Classificació Socio-econ. Set r_ref(1) = Range(Cells(294, 1), Cells(393, 15)) ' Referència ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Crea el full de càlcul on escriu els resultats definitius' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" Call COMUNS_0NOMSFULLS("IRPF(R)") ActiveWorkbook.Unprotect (SECRET) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriu els resultats de la referència ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate Sheets("IRPF(R)").Activate Set r_ref(2) = Range(Cells(1, 1), Cells(100, 15)) With r_ref(2) .ColumnWidth = 6.43 .RowHeight = 9 End With r_ref(2).Rows(1).RowHeight = 14 r_ref(1).Copy Destination:=r_ref(2) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(101, 1)) fila = 100 For i1 = 1 To UBound(IRESULTS) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Lectura en els arxius temporals de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' nom = NOM_IRPF_SIMUL & "S" & ANOIRPF & "_" & Trim(Str(IRESULTS(i1))) & ".xlsx" Set LLIBRE_RESULTATS = Workbooks.Open(nom) llibre(2) = Workbooks.Count Workbooks(llibre(2)).Activate ' llibre "RESULTATS" Sheets("PARAMETRES").Activate ' Paràmetres ReDim p(41, 27) For i = 0 To UBound(p, 1) For j1 = 1 To UBound(p, 2) p(i, j1) = Cells(i + 1, j1) Next j1 Next i Sheets("DESCRIPTIU").Activate ' Descriptiu Set r_f(1, 2) = Range(Cells(1, 1), Cells(28, 8)) Sheets("LIMITS-MITJANES").Activate ' Límits i mitjanes Set r_f(2, 2) = Range(Cells(1, 1), Cells(4, 12)) Sheets("G-P").Activate ' Guanyadors-Perdedors Set r_f(3, 2) = Range(Cells(1, 1), Cells(6, 12)) Sheets("DECILS-RTC").Activate ' Decils (RTC) Set r_f(4, 2) = Range(Cells(1, 1), Cells(56, 12)) Sheets("TIPUS-RTC").Activate ' Tipus (RTC) Set r_f(5, 2) = Range(Cells(1, 1), Cells(24, 12)) Sheets("DECILS-BIT").Activate ' Decils (BIT) Set r_f(6, 2) = Range(Cells(1, 1), Cells(56, 12)) Sheets("TIPUS-BIT").Activate ' Tipus (BIT) Set r_f(7, 2) = Range(Cells(1, 1), Cells(24, 12)) Sheets("INDEXS").Activate ' Indexs Set r_f(8, 2) = Range(Cells(1, 1), Cells(3, 1)) Set r_f(9, 2) = Range(Cells(4, 1), Cells(22, 12)) Sheets("SOCIO-ECONOMICA").Activate ' Classificació socio-econòmica Set r_f(10, 2) = Range(Cells(1, 2), Cells(72, 11)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriptura en el full definitiu de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" With Range(Cells(fila + 1, 1), Cells(fila + 379, 15)) .ColumnWidth = 6.43 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 9 End With With Range(Cells(fila + 1, 1), Cells(fila + 1, 1)) .HorizontalAlignment = xlLeft With .Font .Bold = True .Size = 10 End With .RowHeight = 14 .Value = "SIMULACIÓN-" & IRESULTS(i1) & " (Base de datos: " & ANOIRPF & _ IIf(p(0, 4) <> ANOIRPF, " proyectada al " & p(0, 4), "") & _ IIf(p(0, 3) = "TOTS", ", Total declarantes", ", solo declarantes obligados") & ")" End With Call IRPF_41ESCRIPTURA_PARAMETRES(fila + 2, p, r_parms) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Rangs per a l' escriptura en el llibre SIMCAT full IRPF(R)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Set r_f(1, 3) = Range(Cells(fila + 53, 1), Cells(fila + 85, 13)) ' Descriptiu Set r_f(1, 4) = Range(Cells(fila + 57, 6), Cells(fila + 84, 13)) Set r_f(2, 3) = Range(Cells(fila + 87, 1), Cells(fila + 92, 15)) ' Límits i mitjanes per decils Set r_f(2, 4) = Range(Cells(fila + 89, 4), Cells(fila + 92, 15)) Set r_f(3, 3) = Range(Cells(fila + 94, 1), Cells(fila + 101, 15)) ' Guanyadors-Perdedors Set r_f(3, 4) = Range(Cells(fila + 96, 4), Cells(fila + 101, 15)) Set r_f(4, 3) = Range(Cells(fila + 103, 1), Cells(fila + 161, 15)) ' Decils(RTC) Set r_f(4, 4) = Range(Cells(fila + 106, 4), Cells(fila + 161, 15)) Set r_f(5, 3) = Range(Cells(fila + 163, 1), Cells(fila + 188, 15)) ' Tipus (RTC) Set r_f(5, 4) = Range(Cells(fila + 165, 4), Cells(fila + 188, 15)) Set r_f(6, 3) = Range(Cells(fila + 190, 1), Cells(fila + 248, 15)) ' Decils(BIT) Set r_f(6, 4) = Range(Cells(fila + 193, 4), Cells(fila + 248, 15)) Set r_f(7, 3) = Range(Cells(fila + 250, 1), Cells(fila + 275, 15)) ' Tipus (BIT) Set r_f(7, 4) = Range(Cells(fila + 252, 4), Cells(fila + 275, 15)) Set r_f(8, 3) = Range(Cells(fila + 277, 1), Cells(fila + 281, 4)) ' Índexs (Gini) Set r_f(8, 4) = Range(Cells(fila + 279, 4), Cells(fila + 281, 4)) Set r_f(9, 3) = Range(Cells(fila + 283, 1), Cells(fila + 304, 15)) ' Índexs (Resta) Set r_f(9, 4) = Range(Cells(fila + 286, 4), Cells(fila + 304, 15)) Set r_f(10, 3) = Range(Cells(fila + 306, 1), Cells(fila + 380, 15)) ' Decils classificació Set r_f(10, 4) = Range(Cells(fila + 308, 6), Cells(fila + 380, 15)) For j1 = 1 To 2 r_f(j1, 1).Copy Destination:=r_f(j1, 3) r_f(j1, 2).Copy: r_f(j1, 4).PasteSpecial xlPasteValues If j1 = 1 Then r_f(j1, 3).Rows(3).Columns(1).Value = p(0, 1) r_f(j1, 3).Rows(3).Columns(2).Value = p(0, 2) r_f(j1, 3).Rows(3).Columns(3).Value = p(0, 25) r_f(j1, 3).Rows(3).Columns(4).Value = p(0, 26) r_f(j1, 3).Rows(3).Columns(5).Value = IIf(p(0, 27) > 1, 1, p(0, 27)) End If Next j1 GP = False ' If p(0, 3) = "TOTS" And p(0, 4) = ANOIRPF And p(0, 10) = ANOIRPF Then GP = True Else GP = False If GP Then r_f(3, 1).Copy Destination:=r_f(3, 3) r_f(3, 2).Copy: r_f(3, 4).PasteSpecial xlPasteValues r_f(3, 4).ShrinkToFit = True End If For j1 = 4 To 10 r_f(j1, 1).Copy Destination:=r_f(j1, 3) r_f(j1, 2).Copy: r_f(j1, 4).PasteSpecial xlPasteValues If j1 = 4 Or j1 = 5 Then Cells(fila + IIf(j1 = 4, 104, 164), 1).Value = Cells(fila + IIf(j1 = 4, 104, 164), 1).Value & _ " (ordenació segons RTC)" If j1 = 6 Or j1 = 7 Then Cells(fila + IIf(j1 = 6, 191, 251), 1).Value = Cells(fila + IIf(j1 = 6, 191, 251), 1).Value & _ " (ordenació segons BIT)" '' Next j1 LLIBRE_RESULTATS.Close ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 102, 1)) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 189, 1)) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 276, 1)) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 380, 1)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Rangs pels gràfics' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Set r_ref(3) = Range(Cells(81, 4), Cells(87, 15)) Set r_ref(4) = Range(Cells(91, 4), Cells(100, 15)) ReDim r_g(1 To IIf(GP, 7, 3), 1 To 8) As Range Set r_g(1, 1) = r_f(4, 4).Rows(2) ' Renda total contribuent (RTC) acumulada (sim) Set r_g(2, 1) = r_f(4, 4).Rows(56) ' Resultat declaració (RD) acumulada (sim) Set r_g(3, 1) = r_f(4, 4).Rows(56) ' Resultat declaració (RD) acumulada (sim) Set r_g(1, 2) = r_f(6, 4).Rows(4) ' Base Imposable total (BIT) acumulada (sim) Set r_g(2, 2) = r_f(6, 4).Rows(56) ' Resultat declaració (RD) acumulada (sim) Set r_g(3, 2) = r_f(6, 4).Rows(56) ' Resultat declaració (RD) acumulada (sim) If GP Then Set r_g(5, 1) = r_ref(3).Rows(2) ' Renda total contribuent (RTC) acumulada (ref) Set r_g(6, 1) = r_ref(3).Rows(4) ' Resultat declaració (RD) acumulada (ref) Set r_g(7, 1) = r_ref(3).Rows(4) ' Resultat declaració (RD) acumulada (ref) Set r_g(5, 2) = r_ref(4).Rows(2) ' Base Imposable total (BIT) acumulada (ref) Set r_g(6, 2) = r_ref(4).Rows(4) ' Resultat declaració (RD) acumulada (ref) Set r_g(7, 2) = r_ref(4).Rows(4) ' Resultat declaració (RD) acumulada (ref) End If Set r_g(1, 3) = r_f(5, 4).Rows(13) ' Tipus efectiu CRA s/RTC (sim) Set r_g(1, 4) = r_f(5, 4).Rows(11) ' Tipus efectiu CLA s/RTC (sim) If GP Then Set r_g(2, 3) = r_ref(3).Rows(7) ' Tipus efectiu CRA s/RTC (ref) Set r_g(2, 4) = r_ref(3).Rows(6) ' Tipus efectiu CLA s/RTC (ref) End If Set r_g(1, 5) = r_f(7, 4).Rows(18) ' Tipus efectiu CRA s/BIT (sim) Set r_g(1, 6) = r_f(7, 4).Rows(16) ' Tipus efectiu CLA s/BIT (sim) If GP Then Set r_g(2, 5) = r_ref(4).Rows(7) ' Tipus efectiu CRA s/BIT (ref) Set r_g(2, 6) = r_ref(4).Rows(6) ' Tipus efectiu CLA s/BIT (ref) End If Set r_g(1, 7) = r_f(7, 4).Rows(23) ' Tipus efectiu CRA s/BLT (sim) Set r_g(1, 8) = r_f(7, 4).Rows(21) ' Tipus efectiu CLA s/BLT (sim) If GP Then Set r_g(2, 7) = r_ref(4).Rows(10) ' Tipus efectiu CRA s/BLT (ref) Set r_g(2, 8) = r_ref(4).Rows(9) ' Tipus efectiu CLA s/BLT (ref) End If ' If GP Then ' Set r_gp(1, 1) = r_f(4, 4).Rows(51) ' Resultat declaració (sim) ' Set r_gp(2, 1) = r_ref(3).Rows(5) ' Resultat declaració (ref) ' Set r_gp(1, 2) = r_f(3, 4).Rows(1) ' % guanyadors' ' Set r_gp(2, 2) = r_f(3, 4).Rows(4) ' % perdedors' ' Set r_gp(1, 3) = r_f(3, 4).Rows(2) ' Total guanys' ' Set r_gp(2, 3) = r_f(3, 4).Rows(5) ' Total pèrdues' ' Set r_gp(1, 4) = r_f(3, 4).Rows(3) ' Mitjana guanyadors' ' Set r_gp(2, 4) = r_f(3, 4).Rows(6) ' Mitjana perdedors' ' r_gp(2, 2).NumberFormat = "0.00%;[Red]0.00%" ' End If Call IRPF_42ESCRIPTURA_GRAFICS(fila + 380, GP, p(0, 3), p(0, 4), r_g, r_gp, IRESULTS(i1)) fila = fila + 472 + IIf(GP, 47, 0) Next i1 LLIBRE_FORMATS.Close Call COMUNS_5IMPRESSIO("IRPF", "R") End Sub Private Sub IRPF_41ESCRIPTURA_PARAMETRES(fila, p, r_parms) Dim i1 As Integer, j1 As Integer Set r_parms(2) = Range(Cells(fila, 1), Cells(fila + 51, 15)) 'Paràmetres r_parms(1).Copy Destination:=r_parms(2) With r_parms(2) For i1 = 1 To p(0, 18) 'Tarifa BG estat For j1 = 1 To 3 .Rows(i1 + 4).Columns(j1).Value = p(8 + i1, j1) Next j1 Next i1 If p(0, 18) <> 10 Then With Range(Cells(fila + p(0, 18) + 4, 1), Cells(fila + 13, 3)) .Borders(xlInsideVertical).LineStyle = xlNone .Interior.Pattern = xlCrissCross End With With Range(Cells(fila + p(0, 18) + 3, 1), Cells(fila + p(0, 18) + 3, 3)).Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With ' Range(Cells(fila + p(0, 18) + 2, 3), Cells(fila + Application.Min(13, p(0, 19)), 3)).Borders(xlEdgeRight).LineStyle = xlNone Range(Cells(fila + 13, 1), Cells(fila + 13, 3)).Borders(xlEdgeBottom).LineStyle = xlNone End If For i1 = 1 To p(0, 19) 'Tarifa BG CATALUNYA (BASE 10 Then With Range(Cells(fila + p(0, 19) + 4, 4), Cells(fila + 13, 6)) .Borders(xlInsideVertical).LineStyle = xlNone .Interior.Pattern = xlCrissCross End With With Range(Cells(fila + p(0, 19) + 3, 4), Cells(fila + p(0, 19) + 3, 6)).Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With Range(Cells(fila + 13, 4), Cells(fila + 13, 6)).Borders(xlEdgeBottom).LineStyle = xlNone End If If p(0, 11) > 0 Then For i1 = 1 To p(0, 20) 'Tarifa BG CATALUNYA (BASE>=LIM_BASE) For j1 = 1 To 3 .Rows(i1 + 4).Columns(j1 + 6).Value = p(8 + i1, j1 + 6) Next j1 Next i1 Cells(fila + 2, 7).Value = "CANARIAS (" & IIf(p(0, 11) = 1, "BIT", "BLT") & " >=" & Format(p(0, 12), "###,###0") & "€)" If p(0, 20) <> 10 Then With Range(Cells(fila + p(0, 20) + 4, 7), Cells(fila + 13, 9)) .Borders(xlInsideVertical).LineStyle = xlNone .Interior.Pattern = xlCrissCross End With With Range(Cells(fila + p(0, 20) + 3, 7), Cells(fila + p(0, 20) + 3, 9)).Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With Range(Cells(fila + 13, 7), Cells(fila + 13, 9)).Borders(xlEdgeBottom).LineStyle = xlNone End If End If If p(0, 11) = 0 Then 'Quan no hi ha doble tarifa a CANARIAS Range(Cells(fila + 1, 1), Cells(fila + 1, 9)).MergeCells = False Range(Cells(fila + 1, 1), Cells(fila + 1, 6)).MergeCells = True With Cells(fila + 1, 6).Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium End With With Range(Cells(fila + 1, 7), Cells(fila + 13, 9)) .Borders(xlInsideHorizontal).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Interior.Pattern = xlCrissCross .Value = "" End With Range(Cells(fila + 13, 7), Cells(fila + 13, 9)).Borders(xlEdgeBottom).LineStyle = xlNone End If j1 = Application.Max(p(0, 18), p(0, 19), p(0, 20)) Range(Cells(fila + j1 + 4, 1), Cells(fila + 13, 9)).Borders(xlInsideVertical).LineStyle = xlNone For i1 = 1 To p(0, 21) 'Tarifa BE For j1 = 1 To 4 .Rows(i1 + 4).Columns(j1 + 9).Value = p(8 + i1, j1 + 9) Next j1 Next i1 Cells(fila + 4, 14) = p(8, 14) If p(0, 21) <> 10 Then With Range(Cells(fila + p(0, 21) + 4, 10), Cells(fila + 13, 13)) .Borders(xlInsideVertical).LineStyle = xlNone .Interior.Pattern = xlCrissCross End With With Range(Cells(fila + p(0, 21) + 3, 10), Cells(fila + p(0, 21) + 3, 13)).Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With Range(Cells(fila + 13, 10), Cells(fila + 13, 13)).Borders(xlEdgeBottom).LineStyle = xlNone For i1 = p(0, 21) + 1 To 10 Cells(fila + 3 + i1, 13).Borders(xlEdgeRight).LineStyle = xlNone Next i1 End If j1 = Application.Max(p(0, 20), p(0, 21)) If j1 <> 10 Then Range(Cells(fila + 4 + j1, 9), Cells(fila + 13, 9)).Borders(xlEdgeRight).LineStyle = xlNone If p(0, 13) = 1 Then 'Mínims personals i familiars For j1 = 1 To 3 For i1 = 1 To 11 .Rows(i1 + 19).Columns(j1 + 2).Value = p(j1, i1) Next i1 Next j1 If p(0, 11) = 1 Then Cells(fila + 17, 4).Value = IIf(p(0, 11) = 1, "BIT", "BLT") Cells(fila + 18, 4).Value = "<" & Format(p(0, 12), "###,###0") & "€" Cells(fila + 17, 5).Value = IIf(p(0, 11) = 1, "BIT", "BLT") Cells(fila + 18, 5).Value = ">=" & Format(p(0, 12), "###,###0") & "€" Else Range(Cells(fila + 16, 4), Cells(fila + 18, 5)).MergeCells = True For i1 = 1 To 11 Range(Cells(fila + 18 + i1, 4), Cells(fila + 18 + i1, 5)).MergeCells = True Next i1 End If Else With Range(Cells(fila + 15, 1), Cells(fila + 29, 5)) .Font.Bold = True .HorizontalAlignment = xlCenter .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "SIN MÍNIMOS PERSONALES y FAMILIARES" .VerticalAlignment = xlCenter .WrapText = True End With End If If p(0, 14) = 1 Then 'Reducció Tributació conjunta .Rows(18).Columns(7).Value = p(4, 1) .Rows(18).Columns(9).Value = p(4, 2) ElseIf p(0, 15) + p(0, 16) + p(0, 17) > 0 Then With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With With Range(Cells(fila + 16, 6), Cells(fila + 17, 11)) .HorizontalAlignment = xlCenter .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "SIN REDUCCIÓN POR TRIBUTACIÓN CONJUNTA" .VerticalAlignment = xlCenter .WrapText = True End With End If If p(0, 15) = 1 Then 'Despeses deduïbles rend. treball .Rows(20).Columns(7).Value = p(5, 1) .Rows(20).Columns(10).Value = p(5, 3) .Rows(21).Columns(7).Value = p(5, 2) .Rows(21).Columns(10).Value = p(5, 4) ElseIf p(0, 14) + p(0, 16) + p(0, 17) > 0 Then With Range(Cells(fila + 18, 6), Cells(fila + 20, 11)) With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With .HorizontalAlignment = xlCenter .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "SIN GASTOS DEDUCIBLES POR RENDIMIENTOS DEL TRABAJO" .VerticalAlignment = xlCenter .WrapText = True End With End If If p(0, 16) = 1 Then 'Reducció rend. treball For i1 = 1 To 2 For j1 = 1 To 3 .Rows(i1 + 23).Columns(j1 + 5).Value = p(5 + i1, j1) Next j1 Next i1 .Rows(25).Columns(9).Value = -p(7, 4) & " x (RNT - " & Format(p(6, 2), "#,#0") & " €)" ElseIf p(0, 14) + p(0, 15) + p(0, 17) > 0 Then With Range(Cells(fila + 21, 6), Cells(fila + 24, 11)) With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With .HorizontalAlignment = xlCenter .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "SIN REDUCCIONES POR RENDIMIENTOS DEL TRABAJO o AAEE" .VerticalAlignment = xlCenter .WrapText = True End With End If If p(0, 17) = 1 Then 'Reducció Plans Pensions .Rows(27).Columns(7).Value = p(8, 1) .Rows(27).Columns(10).Value = p(8, 3) .Rows(28).Columns(7).Value = p(8, 2) .Rows(28).Columns(10).Value = p(8, 4) ElseIf p(0, 14) + p(0, 15) + p(0, 16) > 0 Then With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With With Range(Cells(fila + 25, 6), Cells(fila + 27, 11)) .HorizontalAlignment = xlCenter .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "SIN REDUCCIONES PLANES PREVISIÓN" .VerticalAlignment = xlCenter End With End If If p(0, 14) + p(0, 15) + p(0, 16) + p(0, 17) = 0 Then With Range(Cells(fila + 15, 6), Cells(fila + 27, 11)) With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium End With .HorizontalAlignment = xlCenter .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "SIN REDUCCIONES EN LA BASE POR GASTOS DEDUCIBLES, RENDIMIENTOS TRABAJO, TRIBUTACIÓN CONJUNTA y PLANES PREVISIÓN" .VerticalAlignment = xlCenter .WrapText = True End With End If If p(0, 5) <> 1 Or p(0, 6) <> 1 Or p(0, 7) <> 1 Or p(0, 8) <> 1 Or p(0, 9) <> 1 Then 'Projecció rendiments For j1 = 1 To 5 .Rows(16 + j1).Columns(15).Value = p(0, j1 + 4) - 1 Next j1 Else With Range(Cells(fila + 15, 12), Cells(fila + 20, 15)) .HorizontalAlignment = xlCenter .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "SIN PROYECTAR LOS RENDIMIENTOS" .VerticalAlignment = xlCenter .Orientation = 0 End With End If If p(0, 22) = 1 Then 'Deduccions CA .Rows(34).Columns(4).Value = p(18 + 1, 1): .Rows(34).Columns(5).Value = p(18 + 1, 2) .Rows(35).Columns(4).Value = p(18 + 2, 1): .Rows(35).Columns(5).Value = p(18 + 2, 2) .Rows(36).Columns(4).Value = p(18 + 3, 1) .Rows(37).Columns(5).Value = p(18 + 5, 1) .Rows(38).Columns(4).Value = p(18 + 9, 1): .Rows(38).Columns(5).Value = p(18 + 9, 2) .Rows(39).Columns(4).Value = p(18 + 12, 1) .Rows(40).Columns(4).Value = p(18 + 13, 1): .Rows(40).Columns(5).Value = p(18 + 13, 2) .Rows(41).Columns(5).Value = p(18 + 14, 1) .Rows(42).Columns(5).Value = p(18 + 17, 1) .Rows(43).Columns(5).Value = p(18 + 18, 1) .Rows(44).Columns(5).Value = p(18 + 19, 1) .Rows(45).Columns(4).Value = p(18 + 20, 1): .Rows(45).Columns(5).Value = p(18 + 20, 2) .Rows(46).Columns(5).Value = p(18 + 22, 1) .Rows(34).Columns(9).Value = p(18 + 4, 1): .Rows(34).Columns(10).Value = p(18 + 4, 2) For j1 = 1 To 6 .Rows(36).Columns(j1 + 8).Value = p(18 + 6, j1) .Rows(38).Columns(j1 + 8).Value = p(18 + 7, j1) Next j1 .Rows(40).Columns(9).Value = p(18 + 8, 1): .Rows(40).Columns(10).Value = p(18 + 8, 2) For j1 = 1 To 4 .Rows(42).Columns(j1 + IIf(j1 < 4, 8, 9)).Value = p(18 + 10, j1) Next j1 .Rows(44).Columns(9).Value = p(18 + 11, 1): .Rows(44).Columns(12).Value = p(18 + 11, 2) .Rows(46).Columns(9).Value = p(18 + 15, 1): .Rows(46).Columns(11).Value = p(18 + 15, 2) .Rows(48).Columns(9).Value = p(18 + 16, 1): .Rows(48).Columns(11).Value = p(18 + 16, 2): .Rows(48).Columns(13).Value = p(18 + 16, 3) For j1 = 1 To 4 .Rows(50).Columns(j1 + 8).Value = p(18 + 21, j1) Next j1 Else With Range(Cells(fila + 31, 1), Cells(fila + 49, 15)) .Font.Bold = True .HorizontalAlignment = xlCenter .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "SIN DEDUCCIONES AUTONÓMICAS" .VerticalAlignment = xlCenter .WrapText = True End With End If End With End Sub Private Sub IRPF_42ESCRIPTURA_GRAFICS(fila, GP, p3, p4, r_g, r_gp, sim) Dim avisgp As Boolean, i1 As Integer, i2 As Integer, j1 As Integer, mmax As Double, mmin As Double, nom() As String, s_r() As Boolean ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriptura en el full definitiu de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' With Range(Cells(fila, 1), Cells(fila + 92, 15)) .ColumnWidth = 6.43 .Interior.ColorIndex = 2 .RowHeight = 10 End With With Range(Cells(fila, 1), Cells(fila, 1)) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "GRÁFICOS DE LA SIMULACIÓN-" & sim & " (Base de datos: " & ANOIRPF & _ IIf(p4 <> ANOIRPF, " proyectada al " & p4, "") & _ IIf(p3 = "TOTS", ", Total declarantes", ", solo declarantes obligados") & ")" End With ReDim nom(1 To 7, 1 To 2), s_r(1 To 7, 1 To 5) For i1 = 1 To 2 nom(1, i1) = "Sim-" & sim & IIf(i1 = 1, "(RTC)", "(BIT)") nom(2, i1) = "Sim-" & sim & "(RD)" nom(3, i1) = "Sim-" & sim & "(RD relativa)" nom(4, i1) = "Equidad" nom(5, i1) = "Ref." & IIf(i1 = 1, "(RTC)", "(BIT)") nom(6, i1) = "Ref.(RD)" nom(7, i1) = "Ref.(RD relativa)" If GP Then ' si hi ha referència s' ha de calcular si les corbes són iguals For i2 = 1 To 3 For j1 = 1 To 12 If Abs(r_g(i2, i1).Columns(j1) - r_g(i2 + 4, i1).Columns(j1)) > 0.005 Then s_r(i2 + 4, i1) = True Exit For End If Next j1 Next i2 End If Next i1 If GP Then ' si hi ha referència s' ha de calcular si les corbes dels tipus són iguals For i1 = 1 To 6 For j1 = 1 To 12 If Abs(r_g(1, i1 + 2).Columns(j1) - r_g(2, i1 + 2).Columns(j1)) > 0.001 Then s_r(i1, 3) = True Exit For End If Next j1 Next i1 mmax = Round(Application.Max(r_g(1, 3), r_g(2, 3), r_g(1, 4), r_g(2, 4), _ r_g(1, 5), r_g(2, 5), r_g(1, 6), r_g(2, 6), _ r_g(1, 7), r_g(2, 7), r_g(1, 8), r_g(2, 8)), 2) mmin = Round(Application.Min(r_g(1, 3), r_g(2, 3), r_g(1, 4), r_g(2, 4), _ r_g(1, 5), r_g(2, 5), r_g(1, 6), r_g(2, 6), _ r_g(1, 7), r_g(2, 7), r_g(1, 8), r_g(2, 8)), 2) Else ' Quan els gràfics no inclouen la referència mmax = Round(Application.Max(r_g(1, 3), r_g(1, 4), r_g(1, 5), r_g(1, 6), r_g(1, 7)), 2) mmin = Round(Application.Min(r_g(1, 3), r_g(1, 4), r_g(1, 5), r_g(1, 6), r_g(1, 7)), 2) End If If mmin < 0 Then mmin = mmin - 0.01 Call COMUNS_41GRAFICS_CORBESLORENZ(fila + 1, GP, "IRPF", nom, r_g, s_r) ' Lorenz Call COMUNS_42GRAFICS_TIPUS(fila + 24, GP, "IRPF", mmin, mmax, r_g, s_r, sim) ' Tipus efectius If GP Then For j1 = 1 To 12 If Abs(r_gp(1, 2).Columns(j1)) > 0.001 Or Abs(r_gp(2, 2).Columns(j1)) > 0.001 Then avisgp = True Exit For End If Next j1 If avisgp Then Call COMUNS_43GRAFICS_GP(fila + 93, ANOIRPF, "IRPF", "(R)", r_gp, sim) ' G-P Else GP = False End If End If For i1 = 1 To Worksheets("IRPF(R)").Shapes.Count - 1 Step 2 Worksheets("IRPF(R)").Shapes(i1).Left = 20 ' Reposicionament imatges Next i1 For i1 = 2 To Worksheets("IRPF(R)").Shapes.Count Step 2 Worksheets("IRPF(R)").Shapes(i1).Left = 310 ' Reposicionament imatges Next i1 ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 93, 1)) If GP Then ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 139, 1)) End Sub Private Sub IRPF_6MEMORIA_TRIBUTARIA_OBRE(opcio2 As Integer) If opcio2 <> 0 Then Open ThisWorkbook.Path & "\COMPROVACIONS\IRPF\Memòria\TaulaTramsBIT\TaulaTramsBIT-" & ANOIRPF & ".txt" For Output As #200 Write #200, "IDENTIFICADOR", "rtc", "bit", "big", "bie", "blt", "red", "mpf", "qf", "pes" Open ThisWorkbook.Path & "\COMPROVACIONS\IRPF\Memòria\TaulaDeduccionsAutonòmiques\TaulaDeduccionsAutonòmiques-" & ANOIRPF & ".txt" For Output As #300 Write #300, "IDENTIFICADOR", "bit", "p917", "p918", "p919", "p920", "p921", "p922", "p923", "p924", "p925", "pes" Open ThisWorkbook.Path & "\COMPROVACIONS\IRPF\Memòria\TaulaEdatsBIT\TaulaEdatsBIT-" & ANOIRPF & ".txt" For Output As #400 Write #400, "IDENTIFICADOR", "edat", "bit", "pes" End If End Sub Private Sub IRPF_6MEMORIA_TRIBUTARIA_CALCULS(opcio2, i1, ed, v435, v491, v492, p917, p918, p919, p920, p921, p922, p923, p924, p925) If opcio2 <> 0 Then Write #200, IDENTIFICADOR(i1), X(i1, 1), X(i1, 2), X(i1, 4), v435, X(i1, 3), X(i1, 6) + X(i1, 7), v491 + v492, X(i1, 28), X(i1, 29) Write #300, IDENTIFICADOR(i1), X(i1, 2), p917, p918, p919, p920, p921, p922, p923, p924, p925, X(i1, 29) Write #400, IDENTIFICADOR(i1), ed, X(i1, 2), X(i1, 29) End If End Sub Private Sub IRPF_6MEMORIA_TRIBUTARIA_TANCA(opcio2 As Integer) If opcio2 <> 0 Then Close #200 Close #300 Close #400 End If End Sub Private Sub IS_10PARAMETRES(opcio As Integer) Dim i1 As Integer ReDim edat1(10) As Integer, tram(15) As Integer, tram_b(11) As Integer, _ per(11) As Integer, per9(11) As Integer, per10(11) As Integer, per11(11) As Integer, per12(11) As Integer, per_red(100) As Integer For i1 = 100 To 0 Step -1 If i1 >= 90 Then per(100 - i1) = i1 If i1 <= 95 And i1 >= 85 Then per9(95 - i1) = i1 If i1 <= 90 And i1 >= 80 Then per10(90 - i1) = i1 If i1 <= 80 And i1 >= 70 Then per11(80 - i1) = i1 If i1 <= 55 And i1 >= 45 Then per12(55 - i1) = i1 If i1 <= 80 And i1 >= 70 Then edat1(80 - i1) = i1 If i1 <= 15 Then tram(15 - i1) = i1 + 1 If i1 <= 11 Then tram_b(11 - i1) = i1 + 1 per_red(100 - i1) = i1 Next i1 If ISIMULS(2) <> 0 Then ReDim sims(1 To ISIMULS(2)) For i1 = ISIMULS(2) To 1 Step -1 sims(ISIMULS(2) - i1 + 1) = CIS(i1) Next i1 End If PAGINA = -1 TORNA: PAGINA = PAGINA + 1 ERR_LEC = True Do While ERR_LEC With IS1 .MultiPage1.Value = PAGINA If .MultiPage1.Value = 0 Then .Caption = "SIMCAN-IS: Reducciones" If .MultiPage1.Value = 1 Then .Caption = "SIMCAN-IS: Tarifa" If .MultiPage1.Value = 2 Then .Caption = "SIMCAN-IS: Bonificaciones" .Caption = .Caption & " (Base de datos: " & ANOIS & ")" .ListBox122.List = edat1 .ListBox131.List = per .ListBox132.List = per .ListBox133.List = per .ListBox134.List = per .ListBox135.List = per .ListBox136.List = per9 .ListBox137.List = per10 .ListBox138.List = per11 .ListBox139.List = per12 .ListBox1310.List = per .ListBox1311.List = per .ListBox1312.List = per .ListBox1313.List = per .ListBox1314.List = per .ListBox1315.List = per .ListBox1316.List = per .ListBox22.List = tram .ListBox23.List = tram .ListBox241.List = tram_b .ListBox245.List = per_red .Llei.Value = True If ISIMULS(2) <> 0 Then .ListBox_SimulRef.List = sims .SimulRef.Visible = True End If .Show End With If SORTIR Then Exit Sub Loop If PAGINA < 2 Then GoTo TORNA If PAGINA = 2 Then Exit Sub End Sub Private Sub IS_20SIMULACIO(opcio As Integer) Dim i1 As Long, it As Integer, j1 As Integer, j2 As Integer ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Càlcul preliminar sobre trams i tipus impositius' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ReDim tt12(1 To NTRAMS12 - IIf(NTRAMS12 <> 1, 1, 0)), tt34(1 To NTRAMS34 - IIf(NTRAMS34 <> 1, 1, 0)) As Double tt12(1) = T12(1) * TIPUS12(1) If NTRAMS12 > 2 Then For it = 2 To NTRAMS12 - 1 tt12(it) = tt12(it - 1) + ((T12(it) - T12(it - 1)) * TIPUS12(it)) Next it End If tt34(1) = T34(1) * TIPUS34(1) If NTRAMS34 > 2 Then For it = 2 To NTRAMS34 - 1 tt34(it) = tt34(it - 1) + ((T34(it) - T34(it - 1)) * TIPUS34(it)) Next it End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Variables d' interès ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ID_AUTO Identificador 650 ' ' ID_AUTO_660 Identificador 660 ' ' GP Grup parentiu ' ' PARENTIU Grau parentiu ' ' GPATRIM Grup patrimoni ' ' EDAT Edat del subjecte passiu ' ' MINUS Grau discapacitat ' ' TRIB Tributació real=1 o teòrica=2 ' ' CLAU Codi benefici fiscal ' ' ' ' C02 Participació cabal hereditari ' ' C03 Percepcions contractes d' assegurança ' ' C04 Béns addicionables ' ' ' ' C06 Valor Plé Domini ' ' C07 Valor Nua Propietat ' ' C08 Donació acumulada ' ' C09 Béns i drets exempts (conv. internacionals)' ' ' ' C301 Reducció parentiu (real) ' ' C401 Reducció parentiu (teòrica) ' ' C302 Reducció minusvalidesa (real) ' ' C402 Reducció minusvalidesa (teòrica) ' ' C303 Reducció persones grans (real) ' ' C403 Reducció persones grans (teòrica) ' ' C304 Reducció imposició decennal(real) ' ' C404 Reducció imposició decennal(teòrica) ' ' C305 Reducció assegurances vida (real) ' ' C405 Reducció assegurances vida (teòrica) ' ' C306 Reducció activitat empr. o prof. (real) ' ' C406 Reducció activitat empr. o prof. (teòrica) ' ' C307 Reducció per participació entitats(real) ' ' C407 Reducció per participació entitats(teòrica)' ' C308 Reducció habitatge habitual(real) ' ' C408 Reducció habitatge habitual(teòrica) ' ' C309 Reducció béns d' interès cultural(real) ' ' C409 Reducció béns d' interès cultural(teòrica) ' ' C310 Reducció explotacions agràries(real) ' ' C410 Reducció explotacions agràries(teòrica) ' ' C311 Reducció finques rústiques(real) ' ' C411 Reducció finques rústiques teorica ' ' C312 Reducció altres(real) ' ' C412 Reducció altres(teòrica) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 1) Base Imposable ' ' X(i1, 2) Total reduccions patrimonials ' ' X(i1, 3) Total Reduccions parentiu ' ' X(i1, 4) Total Reduccions personals ' ' X(i1, 5) Total Reduccions ' ' X(i1, 6) Base Liquidable ' ' X(i1, 7) Quota Íntegra ' ' X(i1, 8) Quota Tributària abans bonificació ' ' X(i1, 9) Bonificació ' ' X(i1, 10) Quota Tributària ' ' X(i1, 11) Factor elevació ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Declaracions de variables que no venen del fitxer de lectura ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim C05 As Double, C10 As Double, C14 As Double, _ aux As Double, base, bon1 As Double, bon2 As Double, bon3 As Double, i_grup As Integer, pagadors As Integer, _ reds As Double, tr1 As Double, tr2 As Double, vgp As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Declaracions de variables del fitxer de lectura' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim ID_AUTO As Long, ID_AUTO_660 As Long, GP As Integer, PARENTIU As String, GPATRIM As Integer, DM As Integer, _ EDAT As Integer, MINUS As Integer, TRIB As Integer, CLAU As String, _ C02 As Double, C03 As Double, C04 As Double, C06 As Double, C07 As Double, C08 As Double, C09 As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS (REDUCCIONS TEÒRIQUES) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Open "C:\SIMCAT\COMPROVACIONS\IS\BI_RED_BL_Q_B.txt" For Output As #100 ' Write #100, "ID_AUTO", "C05", "C301", "C302", "C303", "C304", "C305", "C306", _ ' "C307", "C308", "C309", "C310", "C311", "C312", "C313", "BL", _ ' "QI", "QTA", "B", "QT" ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Open "C:\SIMCAT\COMPROVACIONS\IS\ReduccionsTeòriques.txt" For Output As #100 ' Write #100, "ID_AUTO", "C10", "C406", "C407", "C410", "C411", "C409", "C404", _ ' "C412", "C405", "C408", "C401", "C402", "C403", "base", "QTt", _ ' "TM", "QIr", "QTr" ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS (BONIFICACIÓ) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Open "C:\SIMCAT\COMPROVACIONS\IS\Bonicacions.txt" For Output As #200 ' Write #200, "ID_AUTO", "TRIB", "GP", "Parentiu", "base", "QT", _ "%bon", "Tram Bon", "Tipus", "t1", "t2", "t1+t2", "Bonificació" ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Lectura de dades' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Open NOM_IS_DADES & ANOIS & ".dat" For Input As #1 Input #1, N ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Declaracions de variables ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ReDim IDENTIFICADOR(1 To N, 1 To 2), IND(1 To N, 1 To 2), i_pag(1 To N, 1 To 3) As Integer, X(1 To N, 1 To 11) ReDim MITJANA(1 To 11, 1 To 3), SUMA(1 To 11, 1 To 3), spes2(1 To 3), vpag(1 To 3, 1 To 3), vx(1 To 10, 1 To 6, 1 To 3) As Double N1 = 0 NT1 = 0 N2 = 0 NT2 = 0 NT = 0 aux = 0 For i1 = 1 To N ReDim C301(7) As Double, C401(7) As Double, C302(2) As Double, C402(2) As Double, C303(1) As Double, C403(1) As Double, _ C304(1) As Double, C404(1) As Double, C305(1) As Double, C405(1) As Double, C306(1) As Double, C406(1) As Double, _ C307(3) As Double, C407(3) As Double, C308(1) As Double, C408(1) As Double, C309(1) As Double, C409(1) As Double, _ C310(6) As Double, C410(6) As Double, C311(1) As Double, C411(1) As Double, C312(2) As Double, C412(2) As Double Input #1, ID_AUTO, ID_AUTO_660, GP, PARENTIU, GPATRIM, DM, EDAT, MINUS, TRIB, CLAU, C02, C03, C04, C06, C07, C08, C09, _ C304(0), C404(0), C306(0), C406(0), C307(0), C407(0), C308(0), C408(0), _ C309(0), C409(0), C310(0), C410(0), C311(0), C411(0), C312(0), C412(0) IDENTIFICADOR(i1, 1) = ID_AUTO IDENTIFICADOR(i1, 2) = GP i_grup = IIf(GP <= 2, 1, 2) ' Indicador grup parentiu ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Per determinar la limitació de la bonificació a la quota quan s' apliquen reduccions patrimonials ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If C306(0) = 0 And C307(0) = 0 And C309(0) = 0 And C310(0) = 0 And C311(0) = 0 And C312(0) = 0 Then reds = 1 Else reds = PER_BON_REDS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Reducció del percentatge de bonificació a la quota com a conseqüència d' aplicar-se determinades reduccions ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' C05 = Application.Max(0, C02 + C03 + C04) ' Base imposable real i teòrica If TRIB = 2 Then C10 = Application.Max(0, C05 + (C06 - C07 + C08 + C09)) If C306(0) <> 0 Or C406(0) <> 0 Then ' Reducció activitat empresarial C306,C406 C306(1) = Application.Min(C05, C306(0) / 0.95 * R306(1)) C05 = C05 - C306(1) If TRIB = 2 Then C406(1) = Application.Min(C10, C406(0) / 0.95 * R306(1)) C10 = C10 - C406(1) End If End If If C307(0) <> 0 Or C407(0) <> 0 Then ' Reducció participació entitats C307,C407 If InStr(1, CLAU, "PR", 1) <> 0 Then C307(1) = Application.Min(C05, C307(0) / 0.95 * R307(1)) If TRIB = 2 Then C407(1) = Application.Min(C10, C407(0) / 0.95 * R307(1)) ElseIf InStr(1, CLAU, "LR", 1) <> 0 Then C307(2) = Application.Min(C05, C307(0) / 0.97 * R307(2)) If TRIB = 2 Then C407(2) = Application.Min(C10, C407(0) / 0.97 * R307(2)) ElseIf InStr(1, CLAU, "VR", 1) <> 0 Then C307(3) = Application.Min(C05, C307(0) / 0.95 * R307(3)) If TRIB = 2 Then C407(3) = Application.Min(C10, C407(0) / 0.95 * R307(3)) End If C05 = C05 - C307(1) - C307(2) - C307(3) If TRIB = 2 Then C10 = C10 - C407(1) - C407(2) - C407(3) End If If C310(0) <> 0 Or C410(0) <> 0 Then ' Reducció Explotacions agràries C310,C410 If InStr(1, CLAU, "EA", 1) <> 0 Then C310(1) = Application.Min(C05, C310(0) * R310(1)) If TRIB = 2 Then C410(1) = Application.Min(C10, C410(0) * R310(1)) ElseIf InStr(1, CLAU, "EB", 1) <> 0 Then C310(2) = Application.Min(C05, C310(0) / 0.9 * R310(2)) If TRIB = 2 Then C410(2) = Application.Min(C10, C410(0) / 0.9 * R310(2)) ElseIf InStr(1, CLAU, "EC", 1) <> 0 Then C310(3) = Application.Min(C05, C310(0) / 0.85 * R310(3)) If TRIB = 2 Then C410(3) = Application.Min(C10, C410(0) / 0.85 * R310(3)) ElseIf InStr(1, CLAU, "ED", 1) <> 0 Then C310(4) = Application.Min(C05, C310(0) / 0.75 * R310(4)) If TRIB = 2 Then C410(4) = Application.Min(C10, C410(0) / 0.75 * R310(4)) ElseIf InStr(1, CLAU, "EF", 1) <> 0 Then C310(5) = Application.Min(C05, C310(0) / 0.5 * R310(5)) If TRIB = 2 Then C410(5) = Application.Min(C10, C410(0) / 0.5 * R310(5)) ElseIf InStr(1, CLAU, "EH", 1) <> 0 Then C310(6) = Application.Min(C05, C310(0) / 0.95 * R310(6)) If TRIB = 2 Then C410(6) = Application.Min(C10, C410(0) / 0.95 * R310(6)) End If C05 = C05 - C310(1) - C310(2) - C310(3) - C310(4) - C310(5) - C310(6) If TRIB = 2 Then C10 = C10 - C410(1) - C410(2) - C410(3) - C410(4) - C410(5) - C410(6) End If If C311(0) <> 0 Or C411(0) <> 0 Then ' Reducció Finques rústiques forestals C311,C411 C311(1) = Application.Min(C05, C311(0) / 0.95 * R311(1)) C05 = C05 - C311(1) If TRIB = 2 Then C411(1) = Application.Min(C10, C411(0) / 0.95 * R311(1)) C10 = C10 - C411(1) End If End If If C309(0) <> 0 Or C409(0) <> 0 Then ' Reducció Béns d'interès cultural C309,C409 C309(1) = Application.Min(C05, C309(0) / 0.95 * R309(1)) C05 = C05 - C309(1) If TRIB = 2 Then C409(1) = Application.Min(C10, C409(0) / 0.95 * R309(1)) C10 = C10 - C409(1) End If End If If C304(0) <> 0 Or C404(0) <> 0 Then ' Imposició decennal C304,C404 C304(1) = Application.Min(C05, C304(0)) C05 = C05 - C304(1) If TRIB = 2 Then C404(1) = Application.Min(C10, C404(0)) C10 = C10 - C404(1) End If End If If C312(0) <> 0 Or C412(0) <> 0 Then ' Reducció Altres C312,C412 If InStr(1, CLAU, "PN", 1) <> 0 Then C312(1) = Application.Min(C05, C312(0) / 0.95 * R312(1)) If TRIB = 2 Then C412(1) = Application.Min(C10, C412(0) / 0.95 * R312(1)) ElseIf InStr(1, CLAU, "RR", 1) <> 0 Then C312(2) = Application.Min(C05, C312(0) / 0.95 * R312(2)) If TRIB = 2 Then C412(2) = Application.Min(C10, C412(0) / 0.95 * R312(2)) End If C05 = C05 - C312(1) - C312(2) If TRIB = 2 Then C10 = C10 - C412(1) - C412(2) End If If C03 <> 0 And GP < 3 Then ' Assegurances sobre la vida C305,C405 C305(1) = Application.Min(C05, Application.Min(C03 * R305(1), R305(2))) C05 = C05 - C305(1) If TRIB = 2 Then C405(1) = Application.Min(C05, Application.Min(C03 * R305(1), R305(2))) C10 = C10 - C405(1) End If End If If C308(0) <> 0 Or C408(0) <> 0 Then ' Habitatge habitual C308,C408 C308(1) = Application.Min(C05, C308(0) / 0.95 * R308(1), R308(2)) C05 = C05 - C308(1) If TRIB = 2 Then C408(1) = Application.Min(C10, C408(0) / 0.95 * R308(1), R308(2)) C10 = C10 - C408(1) End If End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Reduccions patrimonials ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 2) = C304(1) + _ C305(1) + _ C306(1) + _ C307(1) + C307(2) + C307(3) + _ C308(1) + _ C309(1) + _ C310(1) + C310(2) + C310(3) + C310(4) + C310(5) + C310(6) + _ C311(1) + _ C312(1) + C312(2) If GP = 1 Then ' Parentiu C301,C401 C301(1) = Application.Min(C05, R301(1, 1) + R301(1, 2) * Application.Min(21 - EDAT, 8)) If TRIB = 2 Then C401(1) = Application.Min(C10, R301(1, 1) + R301(1, 2) * Application.Min(21 - EDAT, 8)) ElseIf GP = 2 Then If PARENTIU = "Cònjuge" Or PARENTIU = "Unió estable de parella" Then C301(2) = Application.Min(C05, R301(2, 1)) If TRIB = 2 Then C401(2) = Application.Min(C10, R301(2, 1)) ElseIf PARENTIU = "Adoptat" Or PARENTIU = "Fill o adoptat" Then C301(3) = Application.Min(C05, R301(3, 1)) If TRIB = 2 Then C401(3) = Application.Min(C10, R301(3, 1)) ElseIf PARENTIU = "Altre descendent consanguini o assimilat" Or PARENTIU = "Descendent consanguini" Then C301(4) = Application.Min(C05, R301(4, 1)) If TRIB = 2 Then C401(4) = Application.Min(C10, R301(4, 1)) ElseIf PARENTIU = "Ascendent consanguini" Or PARENTIU = "Adoptant" Then C301(5) = Application.Min(C05, R301(5, 1)) If TRIB = 2 Then C401(5) = Application.Min(C10, R301(5, 1)) End If ElseIf GP = 3 Then C301(6) = Application.Min(C05, R301(6, 1)) If TRIB = 2 Then C401(6) = Application.Min(C10, R301(6, 1)) ElseIf GP = 4 Then If PARENTIU = "Situació de convivència d'ajuda mútua" Then C301(7) = Application.Min(C05, R301(7, 1)) If TRIB = 2 Then C401(7) = Application.Min(C10, R301(7, 1)) End If End If X(i1, 3) = C301(1) + C301(2) + C301(3) + C301(4) + C301(5) + C301(6) + C301(7) ' Reduccions parentiu totals C05 = C05 - X(i1, 3) If TRIB = 2 Then C10 = C10 - C401(1) - C401(2) - C401(3) - C401(4) - C401(5) - C401(6) - C401(7) If MINUS <> 0 Then ' Minusvalidesa C302,C402 If MINUS >= 33 And MINUS < 65 Then C302(1) = Application.Min(C05, R302(1)) If TRIB = 2 Then C402(1) = Application.Min(C10, R302(1)) End If If MINUS >= 65 Then C302(2) = Application.Min(C05, R302(2)) If TRIB = 2 Then C402(2) = Application.Min(C10, R302(2)) End If C05 = C05 - C302(1) - C302(2) If TRIB = 2 Then C10 = C10 - C402(1) - C402(2) End If If EDAT >= R303(1) And (GP < 3 Or PARENTIU = "Situació de convivència d'ajuda mútua") Then ' Persones grans C303,C403 If (C302(1) + C302(2)) = 0 Then C303(1) = Application.Min(C05, R303(2)) C05 = C05 - C303(1) End If If TRIB = 2 Then If (C402(1) + C402(2)) = 0 Then C403(1) = Application.Min(C10, R303(2)) C10 = C10 - C403(1) End If End If End If X(i1, 4) = C302(1) + C302(2) + C303(1) ' Reduccions personals totals X(i1, 5) = X(i1, 2) + X(i1, 3) + X(i1, 4) X(i1, 1) = Application.Max(0, C02 + C03 + C04) ' Recàlcul Base imposable real X(i1,1) i teòrica C10 If TRIB = 2 Then C10 = Application.Max(0, X(i1, 1) + C06 - C07 + C08 + C09) X(i1, 6) = Application.Max(0, X(i1, 1) - X(i1, 5)) ' Base liquidable real X(i1, 6) i teòrica C14 If TRIB = 2 Then C14 = Application.Max(0, C10 - (C401(1) + C401(2) + C401(3) + C401(4) + C401(5) + C401(6) + C401(7) + _ C402(1) + C402(2) + _ C403(1) + _ C404(1) + _ C405(1) + _ C406(1) + _ C407(1) + C407(2) + C407(3) + _ C408(1) + _ C409(1) + _ C410(1) + C410(2) + C410(3) + C410(4) + C410(5) + C410(6) + _ C411(1) + _ C412(1) + C412(2))) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina la Quota íntegra X(i1, 7) i Quota tributària abans bonificació X(i1, 8) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' base = X(i1, 6) If TRIB = 2 Then base = C14 If base > 0 Then If GP < 3 Or PARENTIU = "Situació de convivència d'ajuda mútua" Then ' tarifa grup parentiu 1 i 2 If NTRAMS12 = 1 Then X(i1, 7) = base * TIPUS12(1) Else it = NTRAMS12 If base <= T12(1) Then X(i1, 7) = base * TIPUS12(1) If NTRAMS12 > 2 Then For j1 = 2 To NTRAMS12 - 1 If base > T12(j1 - 1) And base <= T12(j1) Then X(i1, 7) = tt12(j1 - 1) + ((base - T12(j1 - 1)) * TIPUS12(j1)) Next j1 End If If base > T12(it - 1) Then X(i1, 7) = tt12(it - 1) + ((base - T12(it - 1)) * TIPUS12(it)) End If ElseIf GP > 2 And PARENTIU <> "Situació de convivència d'ajuda mútua" Then ' tarifa grup parentiu 3 i 4 If NTRAMS34 = 1 Then X(i1, 7) = base * TIPUS34(1) Else it = NTRAMS34 If base <= T34(1) Then X(i1, 7) = base * TIPUS34(1) If NTRAMS34 > 2 Then For j1 = 2 To NTRAMS34 - 1 If base > T34(j1 - 1) And base <= T34(j1) Then X(i1, 7) = tt34(j1 - 1) + ((base - T34(j1 - 1)) * TIPUS34(j1)) Next j1 End If If base > T34(it - 1) Then X(i1, 7) = tt34(it - 1) + ((base - T34(it - 1)) * TIPUS34(it)) End If End If X(i1, 8) = X(i1, 7) * COEF(GP, GPATRIM) ' Quota tributària abans bonificació If PARENTIU = "Situació de convivència d'ajuda mútua" Then X(i1, 8) = X(i1, 7) * COEF(2, GPATRIM) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If TRIB = 2 Then ' Write #100, ID_AUTO, C10, C406(0), C407(0), C410(0), C411(0), C409(0), C404(0), _ ' C412(0), C405(0), C408(0), C401(0), C402(0), C403(0), base, _ ' X(i1, 8), Application.RoundDown(X(i1, 8) / base, 4), _ ' X(i1, 6) * Application.RoundDown(X(i1, 8) / base, 4) / COEF(GP, GPATRIM), _ ' X(i1, 6) * Application.RoundDown(X(i1, 8) / base, 4) ' End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Correcció de la tarifa pel tipus efectiu mitjà, quan hi ha tributació teòrica ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If TRIB = 2 Then X(i1, 8) = X(i1, 6) * Application.RoundDown(X(i1, 8) / base, 4) If PARENTIU = "Situació de convivència d'ajuda mútua" Then X(i1, 7) = X(i1, 8) * COEF(2, GPATRIM) Else X(i1, 7) = X(i1, 8) / COEF(GP, GPATRIM) End If End If End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Aplicació de les bonificacions a la quota tributària ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 9) = 0 ' Bonificació If X(i1, 8) > 0 And GP < 3 Then If PARENTIU = "Cònjuge" Or PARENTIU = "Unió estable de parella" Then X(i1, 9) = X(i1, 8) * BON_IS(0, 3) Else If TRIB = 1 Then base = X(i1, 1) Else base = C10 j1 = 1 If j1 = NTRAMS_BON_IS Then X(i1, 9) = X(i1, 8) * BON_IS(j1, 3) * reds GoTo ACABAR End If TORNAR: If base > BON_IS(j1, 1) And base <= BON_IS(j1 + 1, 1) Then bon1 = BON_IS(j1, 1): bon2 = BON_IS(j1, 2): bon3 = BON_IS(j1, 3) tr1 = (BON_IS(j1, 1) / base) * BON_IS(j1, 2) * reds tr2 = ((base - BON_IS(j1, 1)) / base) * BON_IS(j1, 3) * reds X(i1, 9) = X(i1, 8) * Application.Round(tr1 + tr2, 4) GoTo ACABAR End If j1 = j1 + 1 If j1 < NTRAMS_BON_IS Then GoTo TORNAR If j1 = NTRAMS_BON_IS Then bon1 = BON_IS(j1, 1): bon2 = BON_IS(j1, 2): bon3 = BON_IS(j1, 3) tr1 = (BON_IS(j1, 1) / base) * BON_IS(j1, 2) * reds tr2 = ((base - BON_IS(j1, 1)) / base) * BON_IS(j1, 3) * reds X(i1, 9) = X(i1, 8) * Application.Round(tr1 + tr2, 4) End If ACABAR: ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Write #200, ID_AUTO, TRIB, GP, PARENTIU, IIf(TRIB = 1, X(i1, 1), C10), X(i1, 8), _ ' bon1, bon2, bon3, tr1, tr2, Application.Round(tr1 + tr2, 4), X(i1, 9) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' End If End If pagadors = 0 ' pagadors X(i1, 10) = X(i1, 8) - X(i1, 9) ' Quota Tributària If X(i1, 10) > 0 Then pagadors = 1 X(i1, 11) = 1 ' Factor elevació ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Write #100, ID_AUTO, X(i1, 1), _ ' C301(1) + C301(2) + C301(3) + C301(4) + C301(5) + C301(6) + C301(7), _ ' C302(1) + C302(2), _ ' C303(1), _ ' C304(1), _ ' C305(1), _ ' C306(1), _ ' C307(1) + C307(2) + C307(3), _ ' C308(1), _ ' C309(1), _ ' C310(1) + C310(2) + C310(3) + C310(4) + C310(5) + C310(6), _ ' C311(1), _ ' C312(1) + C312(2), _ ' X(i1, 6), _ ' X(i1, 7), _ ' X(i1, 8), _ ' X(i1, 9), _ ' X(i1, 10) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Discrimina les variables per grup de parentiu ' ' Determina les variables per al càlcul dels "no-pagadors" vpag' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If i_grup = 1 Then N1 = N1 + 1 NT1 = NT1 + X(i1, 11) i_pag(i1, 1) = pagadors Else N2 = N2 + 1 NT2 = NT2 + X(i1, 11) i_pag(i1, 2) = pagadors End If NT = NT + X(i1, 11) vpag(1, i_grup) = vpag(1, i_grup) + (i_pag(i1, i_grup) * X(i1, 11)) vpag(2, i_grup) = vpag(2, i_grup) + (i_pag(i1, i_grup) * X(i1, 11) * X(i1, 11)) vpag(3, i_grup) = vpag(3, i_grup) + (i_pag(i1, i_grup) * i_pag(i1, i_grup) * X(i1, 11) * X(i1, 11)) i_pag(i1, 3) = pagadors vpag(1, 3) = vpag(1, 3) + (i_pag(i1, 3) * X(i1, 11)) vpag(2, 3) = vpag(2, 3) + (i_pag(i1, 3) * X(i1, 11) * X(i1, 11)) vpag(3, 3) = vpag(3, 3) + (i_pag(i1, 3) * i_pag(i1, 3) * X(i1, 11) * X(i1, 11)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina les variables per al càlcul descriptiu vx' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To 10 If X(i1, j1) <> 0 Then vx(j1, 1, i_grup) = vx(j1, 1, i_grup) + (X(i1, j1) * X(i1, 11)) vx(j1, 2, i_grup) = vx(j1, 2, i_grup) + (X(i1, j1) * X(i1, 11) * X(i1, 11)) vx(j1, 3, i_grup) = vx(j1, 3, i_grup) + (X(i1, j1) * X(i1, j1) * X(i1, 11) * X(i1, 11)) vx(j1, 4, i_grup) = vx(j1, 4, i_grup) + 1 vx(j1, 5, i_grup) = vx(j1, 5, i_grup) + X(i1, 11) vx(j1, 6, i_grup) = vx(j1, 6, i_grup) + (X(i1, 11) * X(i1, 11)) vx(j1, 1, 3) = vx(j1, 1, 3) + (X(i1, j1) * X(i1, 11)) vx(j1, 2, 3) = vx(j1, 2, 3) + (X(i1, j1) * X(i1, 11) * X(i1, 11)) vx(j1, 3, 3) = vx(j1, 3, 3) + (X(i1, j1) * X(i1, j1) * X(i1, 11) * X(i1, 11)) vx(j1, 4, 3) = vx(j1, 4, 3) + 1 vx(j1, 5, 3) = vx(j1, 5, 3) + X(i1, 11) vx(j1, 6, 3) = vx(j1, 6, 3) + (X(i1, 11) * X(i1, 11)) End If Next j1 spes2(i_grup) = spes2(i_grup) + (X(i1, 11) * X(i1, 11)) spes2(3) = spes2(3) + (X(i1, 11) * X(i1, 11)) Next i1 Close #1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Close #100 ' Close #200 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim k1 As Integer For k1 = 1 To 3 For j1 = 1 To 10 SUMA(j1, k1) = vx(j1, 1, k1) MITJANA(j1, k1) = SUMA(j1, k1) / IIf(k1 = 1, NT1, IIf(k1 = 2, NT2, NT)) Next j1 Next k1 MITJANA(11, 1) = NT1 / N1 MITJANA(11, 2) = NT2 / N2 MITJANA(11, 3) = NT / N ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda(Descriptiu) a VT)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim v As Integer, naux As Long, obs As Long, tobs ReDim VT(1 To 132, 12) ' 207 VT(1, 0) = "Descriptiu" For k1 = 1 To 3 For j1 = 1 To 10 v = 3 * (j1 - 1) + k1 If vx(j1, 4, k1) <> 0 Then VT(v, 1) = vx(j1, 1, k1) / vx(j1, 5, k1) VT(v, 2) = (Sqr(vx(j1, 3, k1) - (2 * VT(v, 1) * vx(j1, 2, k1)) + ((VT(v, 1) ^ 2) * vx(j1, 6, k1))) / vx(j1, 5, k1)) If VT(v, 1) >= 2 * VT(v, 2) Then VT(v, 3) = VT(v, 1) - 1.95996 * VT(v, 2) VT(v, 4) = VT(v, 1) + 1.95996 * VT(v, 2) Else VT(v, 2) = 0 VT(v, 3) = VT(v, 1) VT(v, 4) = VT(v, 1) End If VT(v, 5) = vx(j1, 1, k1) / 1000000 VT(v, 6) = Sqr(vx(j1, 3, k1) - ((vx(j1, 1, k1) ^ 2) / vx(j1, 4, k1))) / 1000000 If VT(v, 5) >= 2 * VT(v, 6) Then VT(v, 7) = VT(v, 5) - 1.95996 * VT(v, 6) VT(v, 8) = VT(v, 5) + 1.95996 * VT(v, 6) Else VT(v, 6) = 0 VT(v, 7) = VT(v, 5) VT(v, 8) = VT(v, 5) End If Else For j2 = 1 To 8 VT(v, j2) = 0 Next j2 End If Next j1 naux = IIf(k1 = 1, NT1, IIf(k1 = 2, NT2, NT)) VT(31 + k1, 1) = naux ' declarants VT(31 + k1, 4) = VT(27 + k1, 5) / VT(k1, 5) ' QT s/BI VT(31 + k1, 5) = VT(27 + k1, 5) / VT(15 + k1, 5) ' QT s/BL VT(31 + k1, 7) = vpag(1, k1) / naux ' pagadors aux = (Sqr(vpag(3, k1) - (2 * VT(31 + k1, 7) * vpag(2, k1)) + ((VT(31 + k1, 7) ^ 2) * spes2(k1))) / naux) If VT(31 + k1, 7) >= 2 * aux Then VT(31 + k1, 6) = VT(31 + k1, 7) - 1.95996 * aux VT(31 + k1, 8) = VT(31 + k1, 7) + 1.95996 * aux Else VT(31 + k1, 7) = 0 VT(31 + k1, 6) = VT(31 + k1, 7) VT(31 + k1, 8) = VT(31 + k1, 7) End If Next k1 Call COMUNS_2ORDENA("IS") Call IS_22DECILS_GP_INDEXS(11) End Sub Private Sub IS_22DECILS_GP_INDEXS(pes As Integer) Dim aux, i1 As Long, i2 As Long, i3 As Long, it As Integer, j1 As Integer, k1 As Integer ReDim p(1 To 12, 2) For j1 = 1 To 12 p(j1, 1) = IIf(j1 < 10, j1 / 10, IIf(j1 = 10, 0.95, IIf(j1 = 11, 0.98, 1))) p(j1, 2) = IIf(j1 < 10, 0.1, IIf(j1 = 10, 0.05, IIf(j1 = 11, 0.03, 0.02))) Next j1 For it = 1 To 2 ReDim xgp(1 To N, 1 To pes, 1 To 3) As Double, xx(1 To N, 1 To pes) i2 = 0 i3 = 0 For i1 = 1 To N If IDENTIFICADOR(IND(i1, it), 2) <= 2 Then i2 = i2 + 1 For j1 = 1 To pes xgp(i2, j1, 1) = X(IND(i1, it), j1) Next j1 ElseIf IDENTIFICADOR(IND(i1, it), 2) >= 3 Then i3 = i3 + 1 For j1 = 1 To pes xgp(i3, j1, 2) = X(IND(i1, it), j1) Next j1 End If For j1 = 1 To pes xgp(i1, j1, 3) = X(IND(i1, it), j1) Next j1 Next i1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula: xx(1 to N, 1 to pes-1) = (variables * factor) acumulades / s(variables * factor) ' Calcula: xx(1 to N, pes) = població acumulada/NT1,NT2,NT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For k1 = 1 To 3 For j1 = 1 To pes - 1 If SUMA(j1, k1) <> 0 Then aux = 0 For i1 = 1 To IIf(k1 = 1, N1, IIf(k1 = 2, N2, N)) aux = aux + (xgp(i1, j1, k1) * xgp(i1, pes, k1)) xx(i1, j1) = aux / SUMA(j1, k1) ' variables Next i1 End If Next j1 aux = 0 For i1 = 1 To IIf(k1 = 1, N1, IIf(k1 = 2, N2, N)) aux = aux + xgp(i1, pes, k1) xx(i1, pes) = aux / IIf(k1 = 1, NT1, IIf(k1 = 2, NT2, NT)) ' pes Next i1 If it = 1 Then Call IS_23DECILS(k1, xgp, p, xx, pes) ' DECILS Call IS_24INDEXS(it, k1, xgp, xx, pes) ' INDEXS Next k1 Next it End Sub Private Sub IS_23DECILS(k1, xgp, p, xx, pes) Dim aux, fila As Integer, i1 As Long, i2 As Long, j1 As Integer, j2 As Integer, l1 As Long ReDim ds(2 * (pes - 1), 12) As Double, ts(1 To 2, 12) As Double i2 = 1 For j2 = 1 To 11 For i1 = i2 To IIf(k1 = 1, N1, IIf(k1 = 2, N2, N)) If xx(i1, pes) >= p(j2, 1) Then p(j2, 0) = i1 ' p(1 to 12, 0=Observació on comença cada decil i2 = i1 Exit For End If Next i1 Next j2 p(12, 0) = IIf(k1 = 1, N1, IIf(k1 = 2, N2, N)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Límits i mitjanes 6=2*k1 3 límits 3 mitjanes ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' DECILS 60=10*k1*2 (dimensió parell decil acumulat) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' TIPUS 6=3*k1 (3 QT s/BI i 3 QT s/BL) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j2 = 1 To 12 l1 = p(j2, 0) For j1 = 1 To pes - 1 ds(2 * j1, j2) = xx(l1, j1) If j2 = 1 Then ds(2 * j1 - 1, j2) = ds(2 * j1, j2) If j2 > 1 Then ds(2 * j1 - 1, j2) = ds(2 * j1, j2) - ds(2 * j1, j2 - 1) Next j1 Next j2 For j2 = 1 To 12 ts(1, j2) = 0 ts(2, j2) = 0 If SUMA(1, k1) <> 0 And ds(1, j2) <> 0 Then ts(1, j2) = (ds(2 * pes - 3, j2) * SUMA(pes - 1, k1)) / (ds(1, j2) * SUMA(1, k1)) ' TIPUS QT s/BI End If If SUMA(6, k1) <> 0 And ds(11, j2) <> 0 Then ts(2, j2) = (ds(2 * pes - 3, j2) * SUMA(pes - 1, k1)) / (ds(11, j2) * SUMA(6, k1)) ' TIPUS QT s/BL End If Next j2 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda límits i mitjanes de BI, decils i tipus a VT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' aux = IIf(k1 = 1, NT1, IIf(k1 = 2, NT2, NT)) For j2 = 1 To 12 fila = 34 + (k1 - 1) + k1 VT(fila, j2) = xgp(p(j2, 0), 1, k1) ' límit VT(fila + 1, j2) = ds(1, j2) * SUMA(1, k1) / (aux * p(j2, 2)) ' mitjana Next j2 For j1 = 1 To 19 Step 2 fila = 40 + ((2 * k1) - 1) + (3 * (j1 - 1)) For j2 = 1 To 12 VT(fila, j2) = ds(j1, j2) ' Decil Next j2 Next j1 For j1 = 2 To 20 Step 2 fila = 41 + ((2 * k1) - 1) + (3 * (j1 - 2)) For j2 = 1 To 12 VT(fila, j2) = ds(j1, j2) ' Decil acumulat Next j2 Next j1 For j1 = 1 To 2 fila = 100 + 3 * (j1 - 1) + k1 For j2 = 1 To 12 VT(fila, j2) = ts(j1, j2) ' Tipus Next j2 Next j1 End Sub Private Sub IS_24INDEXS(it, k1, xgp, xx, pes) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' INDEXS 2*3 + 8*3*4 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Gini: g (6)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Concentració: c 8*3' ' Kakwani: k 8*3' ' Suits: s 8*3' ' Efecte Redistributiu: e 8*3' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim aconc, aefre, agini, asuit, daux(1 To 4), i1 As Long, j1 As Integer, j2 As Integer, j3 As Integer, k2 As Integer, naux, taux, sxx_b As Double Dim g As Double ReDim i(1 To pes - 3), c(1 To pes - 3), k(1 To pes - 3), s(1 To pes - 3), e(1 To pes - 3) As Double naux = IIf(k1 = 1, N1, IIf(k1 = 2, N2, N)) taux = IIf(k1 = 1, NT1, IIf(k1 = 2, NT2, NT)) agini = 0 sxx_b = 0 For i1 = 1 To naux daux(1) = xgp(i1, IIf(it = 1, 1, 6), k1) - MITJANA(IIf(it = 1, 1, 6), k1) daux(2) = xx(i1, pes) - MITJANA(pes, k1) daux(3) = xgp(i1, pes, k1) agini = agini + (daux(1) * daux(2) * daux(3)) sxx_b = sxx_b + xx(i1, it) ' s.acum. BI,BL Next i1 If agini <> 0 Then g = 2 / MITJANA(IIf(it = 1, 1, 6), k1) * (agini / taux) ' gini For j1 = 1 To pes - 3 i(1) = 2 ' Reduccions patrimonials i(2) = 3 ' Reduccions parentiu i(3) = 4 ' Reduccions personals i(4) = 5 ' Total reduccions i(5) = 7 ' Quota íntegra i(6) = 8 ' Quota tributària abans bonificació i(7) = 9 ' Bonificació i(8) = 10 ' Quota tributària aconc = 0: aefre = 0: asuit = 0 If SUMA(i(j1), k1) <> 0 Then For i1 = 1 To naux daux(1) = xgp(i1, i(j1), k1) - MITJANA(i(j1), k1) daux(2) = xx(i1, pes) - MITJANA(pes, k1) daux(3) = xgp(i1, pes, k1) daux(4) = xx(i1, IIf(it = 1, 1, 6)) - (sxx_b / naux) aconc = aconc + (daux(1) * daux(2) * daux(3)) asuit = asuit + (daux(1) * daux(4) * daux(3)) Next i1 If aconc <> 0 Then c(j1) = 2 / MITJANA(i(j1), k1) * (aconc / taux) ' concentració k(j1) = c(j1) - g ' kakwani If MITJANA(i(j1), k1) <> 0 Then s(j1) = (2 * (asuit / taux) / MITJANA(i(j1), k1)) - g ' suits If SUMA(IIf(it = 1, 1, 6), k1) <> 0 Then aefre = SUMA(i(j1), k1) / SUMA(IIf(it = 1, 1, 6), k1) If aefre <> 1 Then e(j1) = (aefre / (1 - aefre)) * k(j1) ' ef red. End If Next j1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda els resultats(Índexs) a VT' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim fil As Integer, col As Integer VT(106 + it, k1) = g ' gini For j2 = 1 To 4 ' tipus índex col = 2 * (j2 - 1) + it For j1 = 1 To 8 ' variable fil = 3 * (j1 - 1) + k1 + 106 + 2 If j2 = 1 Then VT(fil, col) = IIf(c(j1) <> 0, c(j1), "----") ' concentració If j2 = 2 Then VT(fil, col) = IIf(k(j1) <> 0, k(j1), "----") ' kakwani If j2 = 3 Then VT(fil, col) = IIf(s(j1) <> 0, s(j1), "----") ' suits If j2 = 4 Then VT(fil, col) = IIf(Abs(e(j1)) < 1 And e(j1) <> 0, e(j1), "----") ' efecte redistributiu Next j1 Next j2 End Sub Private Sub IS_30COMPARACIO(opcio As Integer) Dim aux, i1 As Long ReDim a(1 To 6), ds(1 To 12, 1 To 12), GP(1 To 24, 1 To 12), nobs(1 To 3) As Long, ntobs(1 To 3), s(1 To 7, 1 To 3) As Double Open NOM_IS_SIMUL & "GP" & ANOIS & "_" & Trim(Str(COMP(1))) & ".dat" For Input As #1 Open NOM_IS_SIMUL & "GP" & ANOIS & "_" & Trim(Str(COMP(2))) & ".dat" For Input As #2 Input #1, nobs(1), nobs(2), nobs(3), ntobs(1), ntobs(2), ntobs(3) Input #1, a(1), a(2), a(3), a(4), a(5) 'Segona línia de noms Input #2, a(1), a(2), a(3), a(4), a(5), a(6) Input #2, a(1), a(2), a(3), a(4), a(5) 'Segona línia de noms N = nobs(3) ReDim X(1 To N, 1 To 7) ' X(1 to N, 7)--> grup de parentiu 1,2 i 3,4 For i1 = 1 To N Input #1, a(1), X(i1, 7), a(2), a(3), X(i1, 1) ' 1a. quota Input #2, a(1), a(2), a(3), a(4), X(i1, 2) ' 2a. quota aux = X(i1, 1) - X(i1, 2) X(i1, 3) = 0 X(i1, 5) = 0 If Abs(aux) > 1 Then If aux > 0 Then X(i1, 3) = 1 X(i1, 5) = 0 Else X(i1, 3) = 0 X(i1, 5) = 1 End If X(i1, 4) = aux * X(i1, 3) X(i1, 6) = aux * X(i1, 5) End If Next i1 Close #1 Close #2 Call IS_31COMPARACIO_DECILS_GP(ds, GP, nobs, ntobs, s) Call IS_32COMPARACIO_ESCRIPTURA(ds, GP, nobs, ntobs, s) Call COMUNS_5IMPRESSIO("IS", "G-P") End Sub Private Sub IS_31COMPARACIO_DECILS_GP(ds, GP, nobs, ntobs, s) Dim aux(1 To 7), aux_p, i1 As Long, i2 As Long, i3 As Long, j1 As Integer, k1 As Integer, k2 As Integer, l1 As Long ReDim gpaux(1 To 8, 1 To 12) As Double, p(1 To 12, 2), xgp(1 To N, 1 To 6, 1 To 3), xx(1 To N, 1 To 7), y(4, 12) As Double i2 = 0 i3 = 0 For i1 = 1 To N If X(i1, 7) <= 2 Then i2 = i2 + 1 For j1 = 1 To 6 xgp(i2, j1, 1) = X(i1, j1) s(j1, 1) = s(j1, 1) + xgp(i2, j1, 1) Next j1 s(7, 1) = s(7, 1) + 1 ElseIf X(i1, 7) >= 3 Then i3 = i3 + 1 For j1 = 1 To 6 xgp(i3, j1, 2) = X(i1, j1) s(j1, 2) = s(j1, 2) + xgp(i3, j1, 2) Next j1 s(7, 2) = s(7, 2) + 1 End If For j1 = 1 To 6 xgp(i1, j1, 3) = X(i1, j1) s(j1, 3) = s(j1, 3) + xgp(i1, j1, 3) Next j1 s(7, 3) = s(7, 3) + 1 Next i1 For j1 = 1 To 12 p(j1, 1) = IIf(j1 < 10, j1 / 10, IIf(j1 = 10, 0.95, IIf(j1 = 11, 0.98, 1))) p(j1, 2) = IIf(j1 < 10, 0.1, IIf(j1 = 10, 0.05, IIf(j1 = 11, 0.03, 0.02))) Next j1 For k1 = 1 To 3 'Per a cada grup de parentiu k1=1=>1,2 k1=2=>3,4 k1=3=>Tots For j1 = 1 To 6 If s(j1, k1) <> 0 Then aux(j1) = 0 For i1 = 1 To nobs(k1) aux(j1) = aux(j1) + xgp(i1, j1, k1) xx(i1, j1) = aux(j1) / IIf(j1 <= 2, s(j1, k1), 1) Next i1 End If Next j1 aux_p = 0 For i1 = 1 To nobs(k1) aux_p = aux_p + 1 xx(i1, 7) = aux_p / s(7, k1) Next i1 i2 = 1 For j1 = 1 To 11 For i1 = i2 To nobs(k1) If xx(i1, 7) >= p(j1, 1) Then p(j1, 0) = i1 ' p(1 to 12, 0) = Observació on comença cada decil i2 = i1 Exit For End If Next i1 Next j1 p(12, 0) = nobs(k1) ' ' ' ' ' ' ' ' ' DECILS' ' ' ' ' ' ' ' ' For k2 = 1 To 12 l1 = p(k2, 0) If k1 = 1 Then ds(2, k2) = xx(l1, 1) ds(8, k2) = xx(l1, 2) ElseIf k1 = 2 Then ds(4, k2) = xx(l1, 1) ds(10, k2) = xx(l1, 2) ElseIf k1 = 3 Then ds(6, k2) = xx(l1, 1) ds(12, k2) = xx(l1, 2) End If Next k2 For j1 = 1 To 11 Step 2 ds(j1, 1) = ds(j1 + 1, 1) For k2 = 2 To 12 ds(j1, k2) = ds(j1 + 1, k2) - ds(j1 + 1, k2 - 1) Next k2 Next j1 ' ' ' ' ' ' ' ' ' ' ' ' ' GUANYADORS-PERDEDORS' ' ' ' ' ' ' ' ' ' ' ' ' For k2 = 1 To 12 l1 = p(k2, 0) For j1 = 1 To 4 y(j1, k2) = xx(l1, j1 + 2) Next j1 Next k2 For k2 = 1 To 12 For j1 = 1 To 8 gpaux(j1, k2) = 0 Next j1 gpaux(1, k2) = (y(1, k2) - y(1, k2 - 1)) / (p(k2, 2) * ntobs(k1)) '%guanyadors gpaux(2, k2) = Round(y(1, k2) - y(1, k2 - 1), 0) 'guanyadors totals gpaux(3, k2) = (y(2, k2) - y(2, k2 - 1)) / 1000 'guanys totals If gpaux(2, k2) <> 0 Then gpaux(4, k2) = gpaux(3, k2) * 1000 / gpaux(2, k2) 'guanys per capita gpaux(5, k2) = (y(3, k2) - y(3, k2 - 1)) / (p(k2, 2) * ntobs(k1)) '%perdedors gpaux(6, k2) = Round(y(3, k2) - y(3, k2 - 1), 0) 'perdedors totals gpaux(7, k2) = (y(4, k2) - y(4, k2 - 1)) / 1000 'guanys totals If gpaux(6, k2) <> 0 Then gpaux(8, k2) = gpaux(7, k2) * 1000 / gpaux(6, k2) 'guanys per capita gpaux(5, k2) = -gpaux(5, k2) 'pel gràfic Next k2 For j1 = 1 To 12 For k2 = 1 To 8 GP(3 * (k2 - 1) + k1, j1) = gpaux(k2, j1) Next k2 Next j1 Next k1 End Sub Private Sub IS_32COMPARACIO_ESCRIPTURA(ds, GP, nobs, ntobs, s) Dim avisgp(1 To 3) As Boolean, fila As Integer, ig As Integer, i1 As Integer, j1 As Integer, _ llibre As Integer, nom As String, nota(1 To 3) As String, r_f(1 To 2, 1 To 3) As Range ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1 to 2, 1)==> formats del llibre "FORMATS", full "IS" ' ' r_f(1 to 2, 2)==> formats del llibre "SIMCAN", full "(G-P)" ' ' r_f(1 to 2, 3)==> formats del llibre "SIMCAN", full "(G-P)" (només valors)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Application.ScreenUpdating = False nom = ThisWorkbook.Path & "\DADES\Formats.XLSX" Set LLIBRE_FORMATS = Workbooks.Open(nom) llibre = Workbooks.Count Workbooks(llibre).Activate ' llibre "FORMATS" Sheets("IS").Activate Set r_f(1, 1) = Range(Cells(222, 1), Cells(242, 15)) ' Decils Set r_f(2, 1) = Range(Cells(244, 1), Cells(270, 15)) ' Guanyadors ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Crea el full de càlcul on escriu els resultats definitius' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" Call COMUNS_0NOMSFULLS("IS(G-P)") ActiveWorkbook.Unprotect (SECRET) Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate Sheets("IS(G-P)").Activate ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Configura el rang d' escriptura' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' With Range(Cells(1, 1), Cells(45, 15)) .ColumnWidth = 6.43 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 11 End With With Range(Cells(1, 1), Cells(2, 1)) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 End With Cells(1, 1).Value = "IMPOST DE SUCCESSIONS" Cells(2, 1).Value = "COMPARACIÓ SIMULACIÓ-" & COMP(1) & " vs. SIMULACIÓ-" & COMP(2) & _ " (Base de dades: " & ANOIS & ")" Set r_f(1, 2) = Range(Cells(3, 1), Cells(23, 15)) ' Decils Rangs d' escriptura Set r_f(2, 2) = Range(Cells(25, 1), Cells(51, 15)) ' Guanyadors Rangs d' escriptura Set r_f(1, 3) = Range(Cells(6, 4), Cells(17, 15)) ' Decils Rangs de valors Set r_f(2, 3) = Range(Cells(28, 4), Cells(51, 15)) ' Guanyadors Rangs de valors ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriu els resultats numèrics' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1, 1).Copy Destination:=r_f(1, 2) r_f(1, 2).Rows(4).Columns(1).Value = "Quota SIMULACIÓ-" & COMP(1) r_f(1, 2).Rows(10).Columns(1).Value = "Quota SIMULACIÓ-" & COMP(2) r_f(1, 2).Rows(16).Columns(1).Value = "SIMULACIÓ-" & COMP(1) r_f(1, 2).Rows(19).Columns(1).Value = "SIMULACIÓ-" & COMP(2) For i1 = 1 To 3 r_f(1, 2).Rows(15 + i1).Columns(4).Value = s(1, i1) r_f(1, 2).Rows(18 + i1).Columns(4).Value = s(2, i1) If s(1, i1) = s(2, i1) Then nota(i1) = "Neutral" ElseIf s(1, i1) > s(2, i1) Then nota(i1) = "Pèrdua en recaptació" Else nota(i1) = "Guany en recaptació" End If r_f(1, 2).Rows(18).Columns(6 + 2 * (i1 - 1)).Value = nota(i1) If nota(i1) <> "Neutral" Then r_f(1, 2).Rows(19).Columns(6 + 2 * (i1 - 1)).Value = s(2, i1) - s(1, i1) Else With Range(Cells(21, 6 + 2 * (i1 - 1)), Cells(23, 6 + 2 * (i1 - 1))) .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "" End With End If r_f(1, 2).Rows(18 + i1).Columns(15).Value = nobs(i1) Next i1 r_f(1, 3).Value = ds r_f(2, 1).Copy Destination:=r_f(2, 2) r_f(2, 3).Value = GP r_f(2, 3).ShrinkToFit = True LLIBRE_FORMATS.Close ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(52, 1)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' Gràfics G-P' ' ' ' ' ' ' ' ' ' ' ' ' ' fila = 51 For i1 = 1 To 3 For j1 = 1 To 12 If Abs(r_f(2, 3).Rows(i1).Columns(j1)) > 0.001 Or _ Abs(r_f(2, 3).Rows(9 + i1).Columns(j1)) > 0.001 Then avisgp(i1) = True Exit For End If Next j1 If avisgp(i1) Then If i1 = 2 And avisgp(2) Then fila = fila + 45 If i1 = 3 And avisgp(3) Then fila = fila + 45 ReDim r_gp(1 To 2, 1 To 4) As Range Set r_gp(1, 1) = r_f(1, 3).Rows(2 * (i1 - 1) + 1) ' Quota Simulació-1' Set r_gp(2, 1) = r_f(1, 3).Rows(2 * (i1 - 1) + 7) ' Quota Simulació-2' Set r_gp(1, 2) = r_f(2, 3).Rows(i1) ' % guanyadors' Set r_gp(2, 2) = r_f(2, 3).Rows(12 + i1) ' % perdedors' Set r_gp(1, 3) = r_f(2, 3).Rows(6 + i1) ' Total guanys' Set r_gp(2, 3) = r_f(2, 3).Rows(18 + i1) ' Total pèrdues' Set r_gp(1, 4) = r_f(2, 3).Rows(9 + i1) ' Mitjana guanyadors' Set r_gp(2, 4) = r_f(2, 3).Rows(21 + i1) ' Mitjana perdedors' With Range(Cells(fila + 1, 1), Cells(fila + 45, 15)) .ColumnWidth = 6.43 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 11 End With With Cells(fila + 1, 1) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "Grups de parentiu: " & IIf(i1 = 1, "1 i 2", IIf(i1 = 2, "3 i 4", "Tots")) End With Call COMUNS_43GRAFICS_GP(fila + 2, ANOIS, "IS", "(G-P)", r_gp, 1) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 46, 1)) End If Next i1 For i1 = 1 To Worksheets("IS(G-P)").Shapes.Count - 1 Step 2 Worksheets("IS(G-P)").Shapes(i1).Left = 10 ' Reposicionament imatges Next i1 For i1 = 2 To Worksheets("IS(G-P)").Shapes.Count Step 2 Worksheets("IS(G-P)").Shapes(i1).Left = 280 ' Reposicionament imatges Next i1 ActiveSheet.Protect (SECRET) End Sub Private Sub IS_40ESCRIPTURA(opcio As Integer) Dim fila As Integer, i As Integer, i1 As Integer, j1 As Integer, k1 As Integer, llibre(1 To 2) As Integer, nom As String, _ r_ref(1 To 2) As Range, r_f(1 To 5, 1 To 4) As Range, r_parms(1 To 2) As Range ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1 to 5, 1)==> formats del llibre "FORMATS", full "IS" ' ' r_f(1 to 5, 2)==> formats del llibre "RESULTATS" temporals ' ' r_f(1 to 5, 3)==> formats del llibre "SIMCAN", full "IS(R)" ' ' r_f(1 to 5, 3)==> formats del llibre "SIMCAN", full "IS(R)" (només valors)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Application.ScreenUpdating = False nom = ThisWorkbook.Path & "\DADES\Formats.XLSX" Set LLIBRE_FORMATS = Workbooks.Open(nom) llibre(1) = Workbooks.Count Workbooks(llibre(1)).Activate ' llibre "FORMATS" Sheets("IS").Activate Set r_parms(1) = Range(Cells(2, 1), Cells(34, 15)) ' Paràmetres Set r_f(1, 1) = Range(Cells(36, 1), Cells(73, 12)) ' Descriptiu (ull amb els tipus que s' escriuen després) Set r_f(2, 1) = Range(Cells(75, 1), Cells(83, 14)) ' Límits i mitjana per decils Set r_f(3, 1) = Range(Cells(85, 1), Cells(153, 15)) ' Decils Set r_f(4, 1) = Range(Cells(155, 1), Cells(159, 6)) ' Índexs Gini Set r_f(5, 1) = Range(Cells(161, 1), Cells(186, 11)) ' Índexs Resta Set r_ref(1) = Range(Cells(188, 1), Cells(220, 15)) ' Referència ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Crea el full de càlcul on escriu els resultats definitius ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" Call COMUNS_0NOMSFULLS("IS(R)") ActiveWorkbook.Unprotect (SECRET) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriu els resultats de la referència' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' fila = 35 ' 18 Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate Sheets("IS(R)").Activate Set r_ref(2) = Range(Cells(1, 1), Cells(fila - 2, 15)) With r_ref(2) .ColumnWidth = 6.43 .RowHeight = 11 End With r_ref(2).Rows(2).RowHeight = 14 r_ref(1).Copy Destination:=r_ref(2) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila - 1, 1)) For i1 = 1 To UBound(IRESULTS) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Lectura en els arxius temporals de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' nom = NOM_IS_SIMUL & "S" & ANOIS & "_" & Trim(Str(IRESULTS(i1))) & ".xlsx" Set LLIBRE_RESULTATS = Workbooks.Open(nom) llibre(2) = Workbooks.Count Workbooks(llibre(2)).Activate ' llibre "RESULTATS" Sheets("PARAMETRES").Activate ' Paràmetres ReDim p(51, 10) For i = 0 To UBound(p, 1) For j1 = 1 To UBound(p, 2) p(i, j1) = Cells(i + 1, j1) Next j1 Next i Sheets("DESCRIPTIU").Activate ' Descriptiu Set r_f(1, 2) = Range(Cells(1, 1), Cells(34, 8)) Sheets("LIMITS-MITJANES").Activate ' Límits i mitjanes Set r_f(2, 2) = Range(Cells(1, 1), Cells(6, 12)) Sheets("DECILS-TIPUS").Activate ' Decils BI i Tipus efectius QT s/BI QT s/BL Set r_f(3, 2) = Range(Cells(1, 1), Cells(66, 12)) Sheets("INDEXS").Activate ' Indexs Set r_f(4, 2) = Range(Cells(1, 1), Cells(2, 3)) ' Indexs Gini Set r_f(5, 2) = Range(Cells(3, 1), Cells(26, 8)) ' Indexs Altres ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriptura en el full definitiu de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" With Range(Cells(fila - 1, 1), Cells(fila + 185, 15)) ' ull .ColumnWidth = 6.43 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 11 End With With Range(Cells(fila - 1, 1), Cells(fila - 1, 1)) With .Font .Bold = True .Size = 10 End With .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "SIMULACIÓ-" & IRESULTS(i1) & " (Base de dades: " & ANOIS & ")" End With Call IS_41ESCRIPTURA_PARAMETRES(fila, p, r_parms) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Rangs per a l' escriptura en el llibre SIMCAT full IS(R)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Set r_f(1, 3) = Range(Cells(fila + 34, 1), Cells(fila + 71, 12)) ' Descriptiu Set r_f(1, 4) = Range(Cells(fila + 38, 5), Cells(fila + 71, 12)) Set r_f(2, 3) = Range(Cells(fila + 73, 1), Cells(fila + 81, 14)) ' Límits i mitjanes per decils Set r_f(2, 4) = Range(Cells(fila + 76, 3), Cells(fila + 81, 14)) Set r_f(3, 3) = Range(Cells(fila + 83, 1), Cells(fila + 151, 15)) ' Decils Set r_f(3, 4) = Range(Cells(fila + 86, 4), Cells(fila + 151, 15)) Set r_f(4, 3) = Range(Cells(fila + 153, 1), Cells(fila + 157, 6)) ' Índexs Gini Set r_f(4, 4) = Range(Cells(fila + 156, 4), Cells(fila + 157, 6)) Set r_f(5, 3) = Range(Cells(fila + 159, 1), Cells(fila + 184, 11)) ' Índexs Resta Set r_f(5, 4) = Range(Cells(fila + 161, 4), Cells(fila + 184, 11)) For j1 = 1 To 5 r_f(j1, 1).Copy Destination:=r_f(j1, 3) r_f(j1, 2).Copy: r_f(j1, 4).PasteSpecial xlPasteValues Next j1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Qüestions particulars (tipus efectius i Reforma 2011) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Cells(fila + 68, 8).Value = "QT s/BI" Cells(fila + 68, 9).Value = "QT s/BL" Cells(fila + 68, 11).Value = "% Pagadors" Cells(fila + 70, 6).Value = " Tipus efectius" If p(17, 3) Then ' Resultats segons R-2011 For j1 = 1 To 3 Cells(fila + IIf(j1 = 1, 47, IIf(j1 = 2, 104, 167)), 1).Value = "Red. personals (persones grans segons R-2011)" Cells(fila + IIf(j1 = 1, 50, IIf(j1 = 2, 110, 170)), 1).Value = "Total Reduccions (+ addicional segons R-2011)" Next j1 End If LLIBRE_RESULTATS.Close ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 82, 1)) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 152, 1)) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 185, 1)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Rangs dels gràfics ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ReDim r_g(1 To 3, 1 To 4) As Range For k1 = 1 To 3 j1 = 2 * (k1 - 1) Set r_g(1, 1) = r_f(3, 4).Rows(2 + j1) ' BI acum. (sim) Set r_g(2, 1) = r_f(3, 4).Rows(56 + j1) ' QT acum. (sim) Set r_g(3, 1) = r_f(3, 4).Rows(56 + j1) ' QT acum. (sim) Set r_g(1, 2) = r_f(3, 4).Rows(32 + j1) ' BL acum. (sim) Set r_g(2, 2) = r_f(3, 4).Rows(56 + j1) ' QT acum. (sim) Set r_g(3, 2) = r_f(3, 4).Rows(56 + j1) ' QT acum. (sim) Set r_g(1, 3) = r_f(3, 4).Rows(60 + k1) ' QT s/BI (sim) Set r_g(1, 4) = r_f(3, 4).Rows(63 + k1) ' QT s/BL (sim) Call IS_42ESCRIPTURA_GRAFICS(fila + 186 + (k1 - 1) * 46, k1, r_g, IRESULTS(i1)) Next k1 fila = fila + 327 If i1 < UBound(IRESULTS) Then ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila - 1, 1)) Next i1 SALTA: LLIBRE_FORMATS.Close Call COMUNS_5IMPRESSIO("IS", "R") End Sub Private Sub IS_41ESCRIPTURA_PARAMETRES(fila, p, r_parms) Dim i1 As Integer, j1 As Integer Set r_parms(2) = Range(Cells(fila, 1), Cells(fila + 32, 15)) ' Paràmetres r_parms(1).Copy Destination:=r_parms(2) With r_parms(2) .Font.Size = 8 For i1 = 1 To p(0, 2) ' tarifa grup parentiu 1 i 2 For j1 = 1 To 3 .Rows(3 + i1).Columns(j1).Value = p(21 + i1, j1) Next j1 Next i1 If p(0, 2) <> 16 Then With Range(Cells(fila + p(0, 2) + 3, 1), Cells(fila + 18, 3)) .Interior.Pattern = xlCrissCross .Value = "" End With With Range(Cells(fila + p(0, 2) + 3, 1), Cells(fila + p(0, 2) + 3, 3)) With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium End With End With Range(Cells(fila + p(0, 2) + 3, 1), Cells(fila + 18, 3)).Borders(xlInsideVertical).LineStyle = xlNone Range(Cells(fila + 13, 1), Cells(fila + 18, 3)).Borders(xlEdgeTop).LineStyle = xlNone End If For i1 = 1 To p(0, 3) ' tarifa grup parentiu 3 i 4 For j1 = 1 To 3 .Rows(3 + i1).Columns(j1 + 3).Value = p(21 + i1, j1 + 4) Next j1 Next i1 If p(0, 3) <> 16 Then With Range(Cells(fila + p(0, 3) + 3, 4), Cells(fila + 18, 6)) .Interior.Pattern = xlCrissCross .Value = "" End With With Range(Cells(fila + p(0, 3) + 3, 4), Cells(fila + p(0, 3) + 3, 6)) With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium End With End With Range(Cells(fila + p(0, 3) + 3, 4), Cells(fila + 18, 6)).Borders(xlInsideVertical).LineStyle = xlNone Range(Cells(fila + 13, 4), Cells(fila + 18, 6)).Borders(xlEdgeTop).LineStyle = xlNone End If If p(0, 2) <> 16 And p(0, 3) <> 16 Then j1 = Application.Max(p(0, 2), p(0, 3)) Range(Cells(fila + j1 + 3, 3), Cells(fila + 18, 3)).Borders(xlEdgeRight).LineStyle = xlNone End If If p(0, 3) < 14 Then Range(Cells(fila + 17, 6), Cells(fila + 18, 6)).Borders(xlEdgeRight).LineStyle = xlNone If p(0, 3) <> 16 Then Range(Cells(fila + 18, 6), Cells(fila + 18, 6)).Borders(xlEdgeBottom).LineStyle = xlNone For i1 = 2 To 4 ' coeficients correctors For j1 = 1 To 4 .Rows(20 + i1).Columns(j1 + 1).Value = p(17 + i1, j1) Next j1 Next i1 .Rows(4).Columns(10).Value = p(1, 1) ' parentiu Grup I .Rows(5).Columns(10).Value = p(1, 2) ' parentiu Grup I increment .Rows(6).Columns(10).Value = p(1, 3) ' parentiu Grup I límit For i1 = 2 To 7 .Rows(5 + i1).Columns(10).Value = p(i1, 1) ' parentiu Grup II, Grup III Next i1 .Rows(15).Columns(10).Value = p(8, 1) ' discapacitat .Rows(16).Columns(10).Value = p(8, 2) .Rows(17).Columns(9).Value = p(9, 1) ' edat .Rows(17).Columns(10).Value = p(9, 2) .Rows(4).Columns(14).Value = p(10, 1) ' Reducció empresa individual .Rows(5).Columns(14).Value = p(11, 1) ' Reducció participacions entitats .Rows(6).Columns(14).Value = p(11, 2) ' Reducció participacions societats laborals .Rows(7).Columns(14).Value = p(11, 3) ' Reducció participacions amb vincle laboral .Rows(8).Columns(14).Value = p(12, 1) ' Reducció explotacions agràries .Rows(9).Columns(14).Value = p(12, 2) ' Reducció explotacions agràries .Rows(10).Columns(14).Value = p(12, 3) ' Reducció explotacions agràries .Rows(11).Columns(14).Value = p(12, 4) ' Reducció explotacions agràries .Rows(12).Columns(14).Value = p(12, 5) ' Reducció explotacions agràries .Rows(13).Columns(14).Value = p(12, 6) ' Reducció explotacions agràries .Rows(14).Columns(14).Value = p(13, 1) ' Reducció finques rústiques .Rows(15).Columns(14).Value = p(14, 1) ' Reducció béns interès cultural .Rows(16).Columns(14).Value = p(15, 1) ' Reducció béns patrimoni natural .Rows(17).Columns(14).Value = p(15, 2) ' Reducció altres .Rows(18).Columns(14).Value = p(16, 1) ' Reducció assegurances .Rows(18).Columns(15).Value = p(16, 2) ' Límit reducció assegurança .Rows(19).Columns(14).Value = p(17, 1) ' Reducció habitatge .Rows(19).Columns(15).Value = p(17, 2) ' Límit reducció habitatge .Rows(26).Columns(5).Value = p(38, 4) ' Bonificació cònjuge For i1 = 1 To 4 ' Bonificacions Grup II .Rows(28 + i1).Columns(1).Value = IIf(p(0, 4) >= i1, i1 & ")", "") .Rows(28 + i1).Columns(2).Value = IIf(p(0, 4) >= i1, p(38 + i1, 2), "") .Rows(28 + i1).Columns(3).Value = IIf(p(0, 4) >= i1, p(38 + i1, 3), "") ' tipus .Rows(28 + i1).Columns(4).Value = IIf(p(0, 4) >= i1, p(38 + i1, 1), "") .Rows(28 + i1).Columns(5).Value = IIf(p(0, 4) >= i1, p(38 + i1, 4), "") ' marginal If p(0, 4) = i1 Then .Rows(28 + i1).Columns(4).Value = "Total" Next i1 For i1 = 1 To 4 ' Bonificacions Grup II .Rows(28 + i1).Columns(6).Value = IIf(p(0, 4) >= i1 + 4, i1 + 4 & ")", "") .Rows(28 + i1).Columns(7).Value = IIf(p(0, 4) >= i1 + 4, p(42 + i1, 2), "") .Rows(28 + i1).Columns(8).Value = IIf(p(0, 4) >= i1 + 4, p(42 + i1, 3), "") ' tipus .Rows(28 + i1).Columns(9).Value = IIf(p(0, 4) >= i1 + 4, p(42 + i1, 1), "") .Rows(28 + i1).Columns(10).Value = IIf(p(0, 4) >= i1 + 4, p(42 + i1, 4), "") ' marginal If p(0, 4) = i1 + 4 Then .Rows(28 + i1).Columns(9).Value = "Total" Next i1 For i1 = 1 To 4 ' Bonificacions Grup II .Rows(28 + i1).Columns(11).Value = IIf(p(0, 4) >= i1 + 8, i1 + 8 & ")", "") .Rows(28 + i1).Columns(12).Value = IIf(p(0, 4) >= i1 + 8, p(46 + i1, 2), "") .Rows(28 + i1).Columns(13).Value = IIf(p(0, 4) >= i1 + 8, p(46 + i1, 3), "") ' tipus .Rows(28 + i1).Columns(14).Value = IIf(p(0, 4) >= i1 + 8, p(46 + i1, 1), "") .Rows(28 + i1).Columns(15).Value = IIf(p(0, 4) >= i1 + 8, p(46 + i1, 4), "") ' marginal If p(0, 4) = i1 + 8 Then .Rows(28 + i1).Columns(14).Value = "Total" Next i1 .Rows(33).Columns(1).Value = "¹Aquests percentatges s'aplicaran en el " & Format(p(51, 1), "##%") & _ " quan es gaudeixi d'alguna reducció patrimonial, exceptuant la d'Assegurança de vida i la d'Habitatge habitual" End With End Sub Private Sub IS_42ESCRIPTURA_GRAFICS(fila, k1, r_g, sim) Dim i1 As Integer, i2 As Integer, j1 As Integer, mmax As Double, nom() As String, s_r() As Boolean ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriptura en el full definitiu de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' With Range(Cells(fila - IIf(k1 = 1, 1, IIf(k1 = 2, 0, -1)), 1), Cells(fila + 46 - IIf(k1 = 1, 1, IIf(k1 = 2, 0, -1)), 15)) .ColumnWidth = 6.43 .Interior.ColorIndex = 2 .RowHeight = 10 End With With Range(Cells(fila - IIf(k1 = 1, 1, IIf(k1 = 2, 0, -1)), 1), Cells(fila - IIf(k1 = 1, 1, IIf(k1 = 2, 0, -1)), 1)) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "GRÀFICS DE LA SIMULACIÓ-" & sim & " (Base de dades: " & ANOIS & _ ", Grups de parentiu: " & IIf(k1 = 1, "1 i 2)", IIf(k1 = 2, "3 i 4)", "Tots)")) End With ReDim nom(1 To 4, 1 To 2), s_r(1 To 5, 1 To 3) For i1 = 1 To 2 nom(1, i1) = "Sim-" & sim & IIf(i1 = 1, "(BI)", "(BL)") nom(2, i1) = "Sim-" & sim & "(QT)" nom(3, i1) = "Sim-" & sim & "(QT relativa)" nom(4, i1) = "Equitat" Next i1 mmax = Round(Application.Max(r_g(1, 3), r_g(1, 4)), 2) If mmax = 0 Then mmax = 0.001 Call COMUNS_41GRAFICS_CORBESLORENZ(fila + IIf(k1 = 1, 0, IIf(k1 = 2, 1, 2)), False, "IS", nom, r_g, s_r) ' Lorenz Call COMUNS_42GRAFICS_TIPUS(fila + 23 + IIf(k1 = 1, 0, IIf(k1 = 2, 1, 2)), False, "IS", 0, mmax, r_g, s_r, sim) ' Tipus efectius If k1 = 2 Then ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 47, 1)) If k1 = 3 Then ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 48, 1)) If k1 = 3 Then For i1 = 1 To Worksheets("IS(R)").Shapes.Count - 1 Step 2 Worksheets("IS(R)").Shapes(i1).Left = 20 ' Reposicionament de les imatges' Next i1 For i1 = 2 To Worksheets("IS(R)").Shapes.Count Step 2 Worksheets("IS(R)").Shapes(i1).Left = 310 ' Reposicionament de les imatges' Next i1 End If End Sub Private Sub ISD_10PARAMETRES(opcio As Integer) Dim i1 As Integer ReDim p0_100(100) As Integer, tram(15) As Integer For i1 = 100 To 0 Step -1 p0_100(i1) = 100 - i1 If i1 <= 15 Then tram(15 - i1) = i1 + 1 Next i1 If ISIMULS(3) <> 0 Then ReDim sims(1 To ISIMULS(3)) For i1 = ISIMULS(3) To 1 Step -1 sims(ISIMULS(3) - i1 + 1) = CID(i1) Next i1 End If PAGINA = -1 TORNA: PAGINA = PAGINA + 1 ERR_LEC = True Do While ERR_LEC With IS2 .MultiPage1.Value = PAGINA If .MultiPage1.Value = 0 Then .Caption = "SIMCAN-ID: Reduccions a la Base Imposable" If .MultiPage1.Value = 1 Then .Caption = "SIMCAN-ID: Coeficients multiplicadors, Tarifa i Bonificacions" .Caption = .Caption & " (Base de dades: " & ANOID & ")" .ListBox11.List = p0_100 .ListBox12.List = p0_100 .ListBox13.List = p0_100 .ListBox14.List = p0_100 .ListBox15.List = p0_100 .ListBox16.List = p0_100 .ListBox17.List = p0_100 .ListBox18.List = p0_100 .ListBox19.List = p0_100 .ListBox110.List = p0_100 .ListBox111.List = p0_100 .ListBox112.List = p0_100 .ListBox113.List = p0_100 .ListBox114.List = p0_100 .ListBox115.List = p0_100 .ListBox22.List = tram .ListBox23.List = tram .ListBox241.List = p0_100 .ListBox243.List = p0_100 .ListBox244.List = p0_100 .Llei.Value = True If ISIMULS(3) <> 0 Then .ListBox_SimulRef.List = sims .SimulRef.Visible = True End If .Show End With If SORTIR Then Exit Sub Loop If PAGINA < 1 Then GoTo TORNA If PAGINA = 1 Then Exit Sub End Sub Private Sub ISD_20SIMULACIO(opcio As Integer) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Variables d' interès ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ID_AUTO = ID_AUTO ' ' ID_SP = ID_SP ' ' GP = Grup parentiu ' ' MINUS = Grau dicapacitat ' ' PARENTIU = Parentiu ' ' C01 = Béns urbans ' ' C02 = Béns rústics ' ' C03 = Valor participacions ' ' C04 = Altres béns ' ' C06 = Càrregues de la donació ' ' C08 = Valor Plé domini ' ' C09 = Valor Nua propetat ' ' C10 = Valor donació acumulada ' ' C11 = Valor donació fora territori ' ' C101R = Reducció per activitats empr. o profess. real ' ' C102R = Reducció per participacions real ' ' C103R = Reducció per béns culturals real ' ' C104R = Reducció per explotacions agràries real ' ' C105R = Reducció per altres béns real ' ' C101T = Reducció per activitats empr. o profess. teòrica ' ' C102T = Reducció per participacions t ' ' C103T = Reducció per béns culturals teòrica ' ' C104T = Reducció per explotacions agràries teòrica ' ' C105T = Reducció per altres béns teòrica ' ' QT = Quota tributària referència ' ' CODI_BF = codi del benefici fiscal ' ' EDAT = Edat subjecte passiu ' ' TRIB = Tipus de tributació (real=1 o teòrica=2) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 1) = Base Imposable ' ' X(i1, 2) = Reduccions ' ' X(i1, 3) = Base Liquidable ' ' X(i1, 4) = Quota Íntegra ' ' X(i1, 5) = Quota tributària ' ' X(i1, 6) = Factor elevació = 1 sempre ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' 0 quan X(i1, 2, 1 to 3)=0 ' ' i_pag(i1, 1 to 3)= ' ' 1 quan X(i1, 2, 1 to 3)>0 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim it As Integer ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Càlcul preliminar sobre trams i tipus impositius' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ReDim tt12(1 To NTRAMS12 - IIf(NTRAMS12 <> 1, 1, 0)), tt34(1 To NTRAMS34 - IIf(NTRAMS34 <> 1, 1, 0)) As Double tt12(1) = T12(1) * TIPUS12(1) If NTRAMS12 > 2 Then For it = 2 To NTRAMS12 - 1 tt12(it) = tt12(it - 1) + ((T12(it) - T12(it - 1)) * TIPUS12(it)) Next it End If tt34(1) = T34(1) * TIPUS34(1) If NTRAMS34 > 2 Then For it = 2 To NTRAMS34 - 1 tt34(it) = tt34(it - 1) + ((T34(it) - T34(it - 1)) * TIPUS34(it)) Next it End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS (REDUCCIONS) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Open ThisWorkbook.Path & "\COMPROVACIONS\ID\Reduccions.txt" For Output As #100 ' Write #100, "ID_AUTO", "CODI_BF", _ ' "C101R", "C102R", "C103R", "C104R", "C105R", "BI", "RED", _ ' "AR", "PR", "LR", "VR", "NR", "HR", "HB", "DB", "MR", "EA", "EB", "EC", "ED", "EF", "RR", "BL", "QI", "QT", "QTa" ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS (QUOTES) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Open ThisWorkbook.Path & "\COMPROVACIONS\ID\Quotes.txt" For Output As #200 ' Write #200, "ID_AUTO", "TRIB", "GP", "base", "QIr", "QTr", "TM", "QTt", "QIt" ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Declaracions de variables del fitxer de lectura' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim ID_AUTO As String, ID_SP As String, GP As Integer, GPATRIM As Integer, MINUS As Integer, PARENTIU As String, _ C01 As Double, C02 As Double, C03 As Double, C04 As Double, C06 As Double, C08 As Double, C09 As Double, C10 As Double, _ C11 As Double, C101R As Double, C101T As Double, C102R As Double, C102T As Double, C103R As Double, C103T As Double, _ C104R As Double, C104T As Double, C105R As Double, C105T As Double, QT As Double, CODI_BF As String, EDAT As Integer, _ TRIB As Integer ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Declaracions de variables utilitzades en els càlculs ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim aux, base, bit, blt, i_grup As Integer, i1 As Long, j1 As Integer, j2 As Integer, pagadors As Integer, redt As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Lectura de dades' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Open NOM_ID_DADES & ANOID & ".dat" For Input As #1 Input #1, N ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Declaracions de variables ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ReDim IDENTIFICADOR(1 To N, 1 To 2), IND(1 To N, 1 To 2), i_pag(1 To N, 1 To 3) As Integer, red_isd(15) As Double, X(1 To N, 1 To 6) ReDim MITJANA(1 To 6, 1 To 3), SUMA(1 To 6, 1 To 3), spes2(1 To 3), vpag(1 To 3, 1 To 3), vx(1 To 5, 1 To 6, 1 To 3) As Double NT = 0 N1 = 0 N2 = 0 NT1 = 0 NT2 = 0 For i1 = 1 To N Input #1, ID_AUTO, ID_SP, GP, GPATRIM, MINUS, PARENTIU, C01, C02, C03, C04, C06, C08, C09, C10, C11, _ C101R, C101T, C102R, C102T, C103R, C103T, C104R, C104T, C105R, C105T, QT, CODI_BF, EDAT, TRIB, X(i1, 6) IDENTIFICADOR(i1, 1) = ID_AUTO IDENTIFICADOR(i1, 2) = GP i_grup = IIf(GP <= 2, 1, 2) ' Indicador grup parentiu ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Base Imposable ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 1) = Application.Max(0, C01 + C02 + C03 + C04 - C06) If TRIB = 2 Then bit = Application.Max(0, X(i1, 1) + C08 + C10 + C11 - C09) Else bit = 0 ' ' ' ' ' ' ' ' ' ' ' ' Reduccions ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To 15 red_isd(j1) = 0 Next j1 red_isd(0) = C101R + C102R + C103R + C104R + C105R redt = C101T + C102T + C103T + C104T + C105T If red_isd(0) = 0 And redt = 0 Then GoTo SALTA_REDUCCIONS If CODI_BF = "0/AR" Or CODI_BF = "1/AR" Then ' EMPRESA INDIVIDUAL o NEGOCI PROFESSIONAL red_isd(1) = (red_isd(0) / 0.95) * R_BASE(1, 1) ElseIf CODI_BF = "0/PR" Or CODI_BF = "1/PR" Then ' PARTICIPACIONS EN ENTITATS red_isd(2) = (red_isd(0) / 0.95) * R_BASE(2, 1) ElseIf CODI_BF = "0/LR" Or CODI_BF = "1/LR" Then ' PARTICIPACIONS EN SOCIETATS LABORALS red_isd(3) = (red_isd(0) / 0.97) * R_BASE(3, 1) ElseIf CODI_BF = "0/VR" Or CODI_BF = "1/VR" Then ' PARTICIPACIONS EN ENTITATS AMB VINCLE LABORAL red_isd(4) = (red_isd(0) / 0.95) * R_BASE(4, 1) ElseIf CODI_BF = "0/NR" Or CODI_BF = "1/NR" Then ' QUANTITATS ADQUISICIÓ EMPRESA o PARTICIPACIONS red_isd(5) = Application.Min(red_isd(0) / 0.95 * R_BASE(5, 1), IIf(MINUS < 33, R_BASE(5, 2), R_BASE(5, 3))) ElseIf CODI_BF = "0/HR" Or CODI_BF = "1/HR" Then ' PATRIMONI HISTÒRIC o CULTURAL red_isd(6) = (red_isd(0) / 0.95) * R_BASE(6, 1) ElseIf CODI_BF = "0/HB" Or CODI_BF = "1/HB" Then ' IMMOBLE DESTINAT A HABITATGE HABITUAL red_isd(7) = Application.Min(red_isd(0) / 0.95 * R_BASE(7, 1), IIf(MINUS < 65, R_BASE(7, 2), R_BASE(7, 3))) ElseIf CODI_BF = "0/DB" Or CODI_BF = "1/DB" Then ' QUANTITATS DESTINADES A HABITATGE HABITUAL red_isd(8) = Application.Min(red_isd(0) / 0.95 * R_BASE(8, 1), IIf(MINUS < 65, R_BASE(8, 2), R_BASE(8, 3))) ElseIf CODI_BF = "0/MR" Or CODI_BF = "1/MR" Then ' APORTACIONS A PATRIMONIS PROTEGITS red_isd(9) = (red_isd(0) / 0.9) * R_BASE(9, 1) ElseIf CODI_BF = "0/EA" Or CODI_BF = "1/EA" Then ' EXPLOTACIONS AGRÀRIES red_isd(10) = (red_isd(0) / 1) * R_BASE(10, 1) ElseIf CODI_BF = "0/EB" Or CODI_BF = "1/EB" Then ' EXPLOTACIONS AGRÀRIES red_isd(11) = (red_isd(0) / 0.9) * R_BASE(11, 1) ElseIf CODI_BF = "0/EC" Or CODI_BF = "1/EC" Then ' EXPLOTACIONS AGRÀRIES red_isd(12) = (red_isd(0) / 0.85) * R_BASE(12, 1) ElseIf CODI_BF = "0/ED" Or CODI_BF = "1/ED" Then ' EXPLOTACIONS AGRÀRIES red_isd(13) = (red_isd(0) / 0.75) * R_BASE(13, 1) ElseIf CODI_BF = "0/EF" Or CODI_BF = "1/EF" Then ' EXPLOTACIONS AGRÀRIES red_isd(14) = (red_isd(0) / 0.5) * R_BASE(14, 1) ElseIf CODI_BF = "0/RR" Or CODI_BF = "1/RR" Then ' ALTRES (RR) red_isd(15) = (red_isd(0) / 0.95) * R_BASE(15, 1) Else red_isd(1) = (C101R / 0.95) * R_BASE(1, 1) ' EMPRESA INDIVIDUAL o NEGOCI PROFESSIONAL red_isd(2) = (C102R / 0.95) * R_BASE(2, 1) ' PARTICIPACIONS EN ENTITATS red_isd(6) = (C103R / 0.95) * R_BASE(6, 1) ' PATRIMONI HISTÒRIC o CULTURAL red_isd(10) = (C104R / 1) * R_BASE(10, 1) ' EXPLOTACIONS AGRÀRIES red_isd(15) = (C105R / 0.95) * R_BASE(15, 1) ' ALTRES (RR) End If For j1 = 1 To 15 red_isd(j1) = Application.Min(X(i1, 1), red_isd(j1)) X(i1, 2) = X(i1, 2) + red_isd(j1) Next j1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Write #100, ID_AUTO, CODI_BF, _ ' C101R, C102R, C103R, C104R, C105R, X(i1, 1), X(i1, 2), _ ' red_isd(1), red_isd(2), red_isd(3), red_isd(4), red_isd(5), red_isd(6), red_isd(7), _ ' red_isd(8), red_isd(9), red_isd(10), red_isd(11), red_isd(12), red_isd(13), red_isd(14), red_isd(15) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' SALTA_REDUCCIONS: ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Base Liquidable ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 3) = Application.Max(0, X(i1, 1) - X(i1, 2)) If TRIB = 2 Then blt = Application.Max(0, bit - redt) Else blt = 0 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina la Quota íntegra segons la tarifa i trams indicats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' base = X(i1, 3) If TRIB = 2 Then base = blt If base > 0 Then If GP <= 2 Then If NTRAMS12 = 1 Then X(i1, 4) = base * TIPUS12(1) Else it = NTRAMS12 If base <= T12(1) Then X(i1, 4) = base * TIPUS12(1) If NTRAMS12 > 2 Then For j1 = 2 To NTRAMS12 - 1 If base > T12(j1 - 1) And base <= T12(j1) Then X(i1, 4) = tt12(j1 - 1) + ((base - T12(j1 - 1)) * TIPUS12(j1)) Next j1 End If If base > T12(it - 1) Then X(i1, 4) = tt12(it - 1) + ((base - T12(it - 1)) * TIPUS12(it)) End If Else If NTRAMS34 = 1 Then X(i1, 4) = base * TIPUS34(1) Else it = NTRAMS34 If base <= T34(1) Then X(i1, 4) = base * TIPUS34(1) If NTRAMS34 > 2 Then For j1 = 2 To NTRAMS34 - 1 If base > T34(j1 - 1) And base <= T34(j1) Then X(i1, 4) = tt34(j1 - 1) + ((base - T34(j1 - 1)) * TIPUS34(j1)) Next j1 End If If base > T34(it - 1) Then X(i1, 4) = tt34(it - 1) + ((base - T34(it - 1)) * TIPUS34(it)) End If End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina la quota per a ingressar amb els coeficients correctors' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 5) = X(i1, 4) * COEF(GP, GPATRIM) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim TM As Double ' If TRIB = 1 Then TM = 0 ' If TRIB = 2 Then TM = Application.rounddown(X(i1, 5) / blt, 4) ' Write #200, ID_AUTO, TRIB, GP, base, X(i1, 4), X(i1, 5), TM, X(i1, 3) * TM, X(i1, 3) * TM / COEF(GP) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Correcció de la tarifa pel tipus efectiu mitjà ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If TRIB = 2 Then X(i1, 5) = X(i1, 3) * Application.RoundDown(X(i1, 5) / base, 4) X(i1, 4) = X(i1, 5) / COEF(GP, GPATRIM) End If End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If Abs(X(i1, 5) - QT) > 0.1 Then Write #100, ID_AUTO, CODI_BF, _ ' C101R, C102R, C103R, C104R, C105R, X(i1, 1), X(i1, 2), _ ' red_isd(1), red_isd(2), red_isd(3), red_isd(4), red_isd(5), red_isd(6), red_isd(7), _ ' red_isd(8), red_isd(9), red_isd(10), red_isd(11), red_isd(12), red_isd(13), red_isd(14), red_isd(15), X(i1, 3), X(i1, 4), X(i1, 5), QT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Aplicació de les bonificacions a la tarifa ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 5) = (1 - BON_ID(GP)) * X(i1, 5) pagadors = 0 ' pagadors If X(i1, 5) > 0 Then pagadors = 1 If i_grup = 1 Then N1 = N1 + 1 NT1 = NT1 + X(i1, 6) i_pag(i1, 1) = pagadors Else N2 = N2 + 1 NT2 = NT2 + X(i1, 6) i_pag(i1, 2) = pagadors End If NT = NT + X(i1, 6) vpag(1, i_grup) = vpag(1, i_grup) + (i_pag(i1, i_grup) * X(i1, 6)) vpag(2, i_grup) = vpag(2, i_grup) + (i_pag(i1, i_grup) * X(i1, 6) * X(i1, 6)) vpag(3, i_grup) = vpag(3, i_grup) + (i_pag(i1, i_grup) * i_pag(i1, i_grup) * X(i1, 6) * X(i1, 6)) i_pag(i1, 3) = pagadors vpag(1, 3) = vpag(1, 3) + (i_pag(i1, 3) * X(i1, 6)) vpag(2, 3) = vpag(2, 3) + (i_pag(i1, 3) * X(i1, 6) * X(i1, 6)) vpag(3, 3) = vpag(3, 3) + (i_pag(i1, 3) * i_pag(i1, 3) * X(i1, 6) * X(i1, 6)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina les variables per al càlcul descriptiu vx ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To 5 If X(i1, j1) <> 0 Then vx(j1, 1, i_grup) = vx(j1, 1, i_grup) + (X(i1, j1) * X(i1, 6)) vx(j1, 2, i_grup) = vx(j1, 2, i_grup) + (X(i1, j1) * X(i1, 6) * X(i1, 6)) vx(j1, 3, i_grup) = vx(j1, 3, i_grup) + (X(i1, j1) * X(i1, j1) * X(i1, 6) * X(i1, 6)) vx(j1, 4, i_grup) = vx(j1, 4, i_grup) + 1 vx(j1, 5, i_grup) = vx(j1, 5, i_grup) + X(i1, 6) vx(j1, 6, i_grup) = vx(j1, 6, i_grup) + (X(i1, 6) * X(i1, 6)) vx(j1, 1, 3) = vx(j1, 1, 3) + (X(i1, j1) * X(i1, 6)) vx(j1, 2, 3) = vx(j1, 2, 3) + (X(i1, j1) * X(i1, 6) * X(i1, 6)) vx(j1, 3, 3) = vx(j1, 3, 3) + (X(i1, j1) * X(i1, j1) * X(i1, 6) * X(i1, 6)) vx(j1, 4, 3) = vx(j1, 4, 3) + 1 vx(j1, 5, 3) = vx(j1, 5, 3) + X(i1, 6) vx(j1, 6, 3) = vx(j1, 6, 3) + (X(i1, 6) * X(i1, 6)) End If Next j1 spes2(i_grup) = spes2(i_grup) + (X(i1, 6) * X(i1, 6)) spes2(3) = spes2(3) + (X(i1, 6) * X(i1, 6)) Next i1 Close #1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Close #100 ' Close #200 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim k1 As Integer For k1 = 1 To 3 For j1 = 1 To 5 SUMA(j1, k1) = vx(j1, 1, k1) MITJANA(j1, k1) = SUMA(j1, k1) / IIf(k1 = 1, NT1, IIf(k1 = 2, NT2, NT)) Next j1 Next k1 MITJANA(6, 1) = NT1 / N1 MITJANA(6, 2) = NT2 / N2 MITJANA(6, 3) = NT / N ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda(Descriptiu) a VT)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim v As Integer, naux As Long, obs As Long, tobs ReDim VT(1 To 102, 1 To 12) For k1 = 1 To 3 For j1 = 1 To 5 v = 3 * (j1 - 1) + k1 If vx(j1, 4, k1) <> 0 Then VT(v, 1) = vx(j1, 1, k1) / vx(j1, 5, k1) VT(v, 2) = (Sqr(vx(j1, 3, k1) - (2 * VT(v, 1) * vx(j1, 2, k1)) + ((VT(v, 1) ^ 2) * vx(j1, 6, k1))) / vx(j1, 5, k1)) If VT(v, 1) >= 2 * VT(v, 2) Then VT(v, 3) = VT(v, 1) - 1.95996 * VT(v, 2) VT(v, 4) = VT(v, 1) + 1.95996 * VT(v, 2) Else VT(v, 2) = 0 VT(v, 3) = VT(v, 1) VT(v, 4) = VT(v, 1) End If VT(v, 5) = vx(j1, 1, k1) / 1000000 VT(v, 6) = Sqr(vx(j1, 3, k1) - (((vx(j1, 1, k1) / 1000000) ^ 2) / vx(j1, 4, k1))) / 1000000 If VT(v, 5) >= 2 * VT(v, 6) Then VT(v, 7) = VT(v, 5) - 1.95996 * VT(v, 6) VT(v, 8) = VT(v, 5) + 1.95996 * VT(v, 6) Else VT(v, 6) = 0 VT(v, 7) = VT(v, 5) VT(v, 8) = VT(v, 5) End If Else For j2 = 1 To 8 VT(v, j2) = 0 Next j2 End If Next j1 VT(15 + k1, 4) = VT(12 + k1, 5) / VT(k1, 5) ' QT s/BI VT(15 + k1, 5) = VT(12 + k1, 5) / VT(k1 + 6, 5) ' QT s/BL Next k1 VT(16, 1) = NT1 ' Declarants 1 i 2 VT(17, 1) = NT2 ' Declarants 3 i 4 VT(18, 1) = NT ' Declarants total VT(16, 7) = vpag(1, 1) / NT1 ' pagadors 1 i 2 aux = (Sqr(vpag(3, 1) - (2 * VT(16, 7) * vpag(2, 1)) + ((VT(16, 7) ^ 2) * spes2(1))) / NT1) VT(16, 6) = VT(16, 7) - 1.95996 * aux VT(16, 8) = VT(16, 7) + 1.95996 * aux If VT(16, 8) > 1 Then VT(16, 8) = 1 VT(17, 7) = vpag(1, 2) / NT2 ' pagadors 3 i 4 aux = (Sqr(vpag(3, 2) - (2 * VT(17, 7) * vpag(2, 2)) + ((VT(17, 7) ^ 2) * spes2(2))) / NT2) VT(17, 6) = VT(17, 7) - 1.95996 * aux VT(17, 8) = VT(17, 7) + 1.95996 * aux If VT(17, 8) > 1 Then VT(17, 8) = 1 VT(18, 7) = vpag(1, 3) / NT ' pagadors total aux = (Sqr(vpag(3, 3) - (2 * VT(18, 7) * vpag(2, 3)) + ((VT(18, 7) ^ 2) * spes2(3))) / NT) VT(18, 6) = VT(18, 7) - 1.95996 * aux VT(18, 8) = VT(18, 7) + 1.95996 * aux If VT(18, 8) > 1 Then VT(18, 8) = 1 Call COMUNS_2ORDENA("ID") Call ISD_22DECILS_GP_INDEXS(6) End Sub Private Sub ISD_22DECILS_GP_INDEXS(pes As Integer) Dim aux, i1 As Long, i2 As Long, i3 As Long, it As Integer, j1 As Integer, k1 As Integer ReDim p(1 To 12, 2) For j1 = 1 To 12 p(j1, 1) = IIf(j1 < 10, j1 / 10, IIf(j1 = 10, 0.95, IIf(j1 = 11, 0.98, 1))) p(j1, 2) = IIf(j1 < 10, 0.1, IIf(j1 = 10, 0.05, IIf(j1 = 11, 0.03, 0.02))) Next j1 For it = 1 To 2 ReDim xgp(1 To N, 1 To pes, 1 To 3) As Double, xx(1 To N, 1 To pes) i2 = 0 i3 = 0 For i1 = 1 To N If IDENTIFICADOR(IND(i1, it), 2) <= 2 Then i2 = i2 + 1 For j1 = 1 To pes xgp(i2, j1, 1) = X(IND(i1, it), j1) Next j1 ElseIf IDENTIFICADOR(IND(i1, it), 2) >= 3 Then i3 = i3 + 1 For j1 = 1 To pes xgp(i3, j1, 2) = X(IND(i1, it), j1) Next j1 End If For j1 = 1 To pes xgp(i1, j1, 3) = X(IND(i1, it), j1) Next j1 Next i1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula: xx(1 to N, 1 to pes-1) = (variables * factor) acumulades / s(variables * factor) ' Calcula: xx(1 to N, pes) = població acumulada/NT1,NT2,NT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For k1 = 1 To 3 For j1 = 1 To pes - 1 If SUMA(j1, k1) <> 0 Then aux = 0 For i1 = 1 To IIf(k1 = 1, N1, IIf(k1 = 2, N2, N)) aux = aux + (xgp(i1, j1, k1) * xgp(i1, pes, k1)) xx(i1, j1) = aux / SUMA(j1, k1) ' variables Next i1 End If Next j1 aux = 0 For i1 = 1 To IIf(k1 = 1, N1, IIf(k1 = 2, N2, N)) aux = aux + xgp(i1, pes, k1) xx(i1, pes) = aux / IIf(k1 = 1, NT1, IIf(k1 = 2, NT2, NT)) ' pes Next i1 If it = 1 Then Call ISD_23DECILS(k1, xgp, p, xx, pes) ' DECILS Call ISD_24INDEXS(it, k1, xgp, xx, pes) ' INDEXS Next k1 Next it End Sub Private Sub ISD_23DECILS(k1, xgp, p, xx, pes) Dim aux, fila As Integer, i1 As Long, i2 As Long, j1 As Integer, j2 As Integer, l1 As Long ReDim ds(2 * (pes - 1), 12) As Double, ts(1 To 2, 12) As Double i2 = 1 For j2 = 1 To 11 For i1 = i2 To IIf(k1 = 1, N1, IIf(k1 = 2, N2, N)) If xx(i1, pes) >= p(j2, 1) Then p(j2, 0) = i1 ' p(1 to 12, 0=Observació on comença cada decil i2 = i1 Exit For End If Next i1 Next j2 p(12, 0) = IIf(k1 = 1, N1, IIf(k1 = 2, N2, N)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Límits i mitjanes 6=2*k1 3 límits 3 mitjanes ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' DECILS 30=5*k1*2 (dimensió parell decil acumulat) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' TIPUS 6=3*k1 (3 QT s/BI i 3 QT s/BL) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j2 = 1 To 12 l1 = p(j2, 0) For j1 = 1 To pes - 1 ds(2 * j1, j2) = xx(l1, j1) If j2 = 1 Then ds(2 * j1 - 1, j2) = ds(2 * j1, j2) If j2 > 1 Then ds(2 * j1 - 1, j2) = ds(2 * j1, j2) - ds(2 * j1, j2 - 1) Next j1 Next j2 For j2 = 1 To 12 ts(1, j2) = 0 ts(2, j2) = 0 If SUMA(1, k1) <> 0 And ds(1, j2) <> 0 Then ts(1, j2) = (ds(2 * pes - 3, j2) * SUMA(pes - 1, k1)) / (ds(1, j2) * SUMA(1, k1)) ' TIPUS QT s/BI End If If SUMA(2, k1) <> 0 And ds(3, j2) <> 0 Then ts(2, j2) = (ds(2 * pes - 3, j2) * SUMA(pes - 1, k1)) / (ds(5, j2) * SUMA(3, k1)) ' TIPUS QT s/BL End If Next j2 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda límits i mitjanes, decils i tipus a VT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' aux = IIf(k1 = 1, NT1, IIf(k1 = 2, NT2, NT)) For j2 = 1 To 12 fila = 18 + (k1 - 1) + k1 VT(fila, j2) = xgp(p(j2, 0), 1, k1) ' límit VT(fila + 1, j2) = ds(1, j2) * SUMA(1, k1) / (aux * p(j2, 2)) ' mitjana Next j2 For j1 = 1 To 9 Step 2 fila = 24 + ((2 * k1) - 1) + (3 * (j1 - 1)) For j2 = 1 To 12 VT(fila, j2) = ds(j1, j2) ' Decil Next j2 Next j1 For j1 = 2 To 10 Step 2 fila = 25 + ((2 * k1) - 1) + (3 * (j1 - 2)) For j2 = 1 To 12 VT(fila, j2) = ds(j1, j2) ' Decil acumulat Next j2 Next j1 For j1 = 1 To 2 fila = 54 + 3 * (j1 - 1) + k1 For j2 = 1 To 12 VT(fila, j2) = ts(j1, j2) ' Tipus Next j2 Next j1 End Sub Private Sub ISD_24INDEXS(it, k1, xgp, xx, pes) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' INDEXS 2*3 + 3*3*4 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Gini: g (6)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Concentració: c 3*3' ' Kakwani: k 3*3' ' Suits: s 3*3' ' Efecte Redistributiu: e 3*3' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' it=1 BI=1 it=2 BL=3 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim aconc, aefre, agini, asuit, daux(1 To 4), i1 As Long, j1 As Integer, j2 As Integer, j3 As Integer, k2 As Integer, naux, taux, sxx_b As Double Dim g As Double ReDim i(1 To pes - 3), c(1 To pes - 3), k(1 To pes - 3), s(1 To pes - 3), e(1 To pes - 3) As Double naux = IIf(k1 = 1, N1, IIf(k1 = 2, N2, N)) taux = IIf(k1 = 1, NT1, IIf(k1 = 2, NT2, NT)) agini = 0 sxx_b = 0 For i1 = 1 To naux daux(1) = xgp(i1, IIf(it = 1, 1, 3), k1) - MITJANA(IIf(it = 1, 1, 3), k1) daux(2) = xx(i1, pes) - MITJANA(pes, k1) daux(3) = xgp(i1, pes, k1) agini = agini + (daux(1) * daux(2) * daux(3)) sxx_b = sxx_b + xx(i1, it) ' s.acum. BI,BL Next i1 If agini <> 0 Then g = 2 / MITJANA(IIf(it = 1, 1, 3), k1) * (agini / taux) ' gini For j1 = 1 To pes - 3 i(1) = 2 ' Total reduccions i(2) = 4 ' Quota íntegra i(3) = 5 ' Quota tributària aconc = 0: aefre = 0: asuit = 0 If SUMA(i(j1), k1) <> 0 Then For i1 = 1 To naux daux(1) = xgp(i1, i(j1), k1) - MITJANA(i(j1), k1) daux(2) = xx(i1, pes) - MITJANA(pes, k1) daux(3) = xgp(i1, pes, k1) daux(4) = xx(i1, IIf(it = 1, 1, 3)) - (sxx_b / naux) aconc = aconc + (daux(1) * daux(2) * daux(3)) asuit = asuit + (daux(1) * daux(4) * daux(3)) Next i1 If aconc <> 0 Then c(j1) = 2 / MITJANA(i(j1), k1) * (aconc / taux) ' concentració k(j1) = c(j1) - g ' kakwani If MITJANA(i(j1), k1) <> 0 Then s(j1) = (2 * (asuit / taux) / MITJANA(i(j1), k1)) - g ' suits If SUMA(IIf(it = 1, 1, 3), k1) <> 0 Then aefre = SUMA(i(j1), k1) / SUMA(IIf(it = 1, 1, 3), k1) If aefre <> 1 Then e(j1) = (aefre / (1 - aefre)) * k(j1) ' ef red. End If Next j1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda els resultats(Índexs) a VT' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim v1 As Integer, v2 As Integer, v3 As Integer v1 = 61 v2 = (k1 - 1) If it = 1 Then VT(v1 + v2 + 3 * (it - 1), 2) = "----" If it = 2 Then VT(v1 + v2 + 3 * (it - 1), 1) = "----" VT(v1 + v2 + 3 * (it - 1), it) = g ' gini For j2 = 1 To 4 For j1 = 1 To 3 v3 = 3 * (j1 - 1) + 9 * (j2 - 1) + 6 If j2 = 1 Then VT(v1 + v2 + v3, it) = c(j1) ' concentració If j2 = 2 Then VT(v1 + v2 + v3, it) = k(j1) ' kakwani If j2 = 3 Then VT(v1 + v2 + v3, it) = s(j1) ' suits If j2 = 4 Then VT(v1 + v2 + v3, it) = e(j1) ' efecte redistributiu Next j1 Next j2 End Sub Private Sub ISD_30COMPARACIO(opcio As Integer) Dim aux, i1 As Long ReDim a(1 To 6), ds(1 To 12, 1 To 12), GP(1 To 24, 1 To 12), nobs(1 To 3) As Long, ntobs(1 To 3), s(1 To 7, 1 To 3) As Double Open NOM_ID_SIMUL & "GP" & ANOID & "_" & Trim(Str(COMP(1))) & ".dat" For Input As #1 Open NOM_ID_SIMUL & "GP" & ANOID & "_" & Trim(Str(COMP(2))) & ".dat" For Input As #2 Input #1, nobs(1), nobs(2), nobs(3), ntobs(1), ntobs(2), ntobs(3) Input #1, a(1), a(2), a(3), a(4), a(5) 'Segona línia de noms Input #2, a(1), a(2), a(3), a(4), a(5), a(6) Input #2, a(1), a(2), a(3), a(4), a(5) 'Segona línia de noms N = nobs(3) ReDim X(1 To N, 1 To 8) For i1 = 1 To N Input #1, a(1), X(i1, 7), X(i1, 8), a(3), X(i1, 1) 'X(, 1) -> 1a. quota; X(, 7) -> grup de parentiu 1,2 i 3,4; X(, 8) -> BI Input #2, a(1), a(2), a(3), a(4), X(i1, 2) 'X(, 2) -> 2a. quota aux = X(i1, 1) - X(i1, 2) X(i1, 3) = 0 X(i1, 5) = 0 If Abs(aux) > 1 Then If aux > 0 Then X(i1, 3) = 1 X(i1, 5) = 0 Else X(i1, 3) = 0 X(i1, 5) = 1 End If X(i1, 4) = aux * X(i1, 3) X(i1, 6) = aux * X(i1, 5) End If Next i1 Close #1 Close #2 Call ISD_31COMPARACIO_DECILS_GP(ds, GP, nobs, ntobs, s) Call ISD_32COMPARACIO_ESCRIPTURA(ds, GP, nobs, ntobs, s) Call COMUNS_5IMPRESSIO("ID", "G-P") End Sub Private Sub ISD_31COMPARACIO_DECILS_GP(ds, GP, nobs, ntobs, s) Dim aux(1 To 7), aux_p, i1 As Long, i2 As Long, i3 As Long, j1 As Integer, k1 As Integer, k2 As Integer, l1 As Long ReDim gpaux(1 To 8, 1 To 12) As Double, p(1 To 12, 2), xgp(1 To N, 1 To 6, 1 To 3), xx(1 To N, 1 To 7), y(4, 12) As Double i2 = 0 i3 = 0 For i1 = 1 To N If X(i1, 7) <= 2 Then i2 = i2 + 1 For j1 = 1 To 6 xgp(i2, j1, 1) = X(i1, j1) s(j1, 1) = s(j1, 1) + xgp(i2, j1, 1) Next j1 s(7, 1) = s(7, 1) + 1 ElseIf X(i1, 7) >= 3 Then i3 = i3 + 1 For j1 = 1 To 6 xgp(i3, j1, 2) = X(i1, j1) s(j1, 2) = s(j1, 2) + xgp(i3, j1, 2) Next j1 s(7, 2) = s(7, 2) + 1 End If For j1 = 1 To 6 xgp(i1, j1, 3) = X(i1, j1) s(j1, 3) = s(j1, 3) + xgp(i1, j1, 3) Next j1 s(7, 3) = s(7, 3) + 1 Next i1 For j1 = 1 To 12 p(j1, 1) = IIf(j1 < 10, j1 / 10, IIf(j1 = 10, 0.95, IIf(j1 = 11, 0.98, 1))) p(j1, 2) = IIf(j1 < 10, 0.1, IIf(j1 = 10, 0.05, IIf(j1 = 11, 0.03, 0.02))) Next j1 For k1 = 1 To 3 For j1 = 1 To 6 If s(j1, k1) <> 0 Then aux(j1) = 0 For i1 = 1 To nobs(k1) aux(j1) = aux(j1) + xgp(i1, j1, k1) xx(i1, j1) = aux(j1) / IIf(j1 <= 2, s(j1, k1), 1) Next i1 End If Next j1 aux_p = 0 For i1 = 1 To nobs(k1) aux_p = aux_p + 1 xx(i1, 7) = aux_p / s(7, k1) Next i1 i2 = 1 For j1 = 1 To 11 For i1 = i2 To nobs(k1) If xx(i1, 7) >= p(j1, 1) Then p(j1, 0) = i1 ' p(1 to 12, 0) = Observació on comença cada decil i2 = i1 Exit For End If Next i1 Next j1 p(12, 0) = nobs(k1) ' ' ' ' ' ' ' ' ' DECILS' ' ' ' ' ' ' ' ' For k2 = 1 To 12 l1 = p(k2, 0) If k1 = 1 Then ds(2, k2) = xx(l1, 1) ds(8, k2) = xx(l1, 2) ElseIf k1 = 2 Then ds(4, k2) = xx(l1, 1) ds(10, k2) = xx(l1, 2) ElseIf k1 = 3 Then ds(6, k2) = xx(l1, 1) ds(12, k2) = xx(l1, 2) End If Next k2 For j1 = 1 To 11 Step 2 ds(j1, 1) = ds(j1 + 1, 1) For k2 = 2 To 12 ds(j1, k2) = ds(j1 + 1, k2) - ds(j1 + 1, k2 - 1) Next k2 Next j1 ' ' ' ' ' ' ' ' ' ' ' ' ' GUANYADORS-PERDEDORS' ' ' ' ' ' ' ' ' ' ' ' ' For k2 = 1 To 12 l1 = p(k2, 0) For j1 = 1 To 4 y(j1, k2) = xx(l1, j1 + 2) Next j1 Next k2 For k2 = 1 To 12 For j1 = 1 To 8 gpaux(j1, k2) = 0 Next j1 gpaux(1, k2) = (y(1, k2) - y(1, k2 - 1)) / (p(k2, 2) * ntobs(k1)) '%guanyadors gpaux(2, k2) = Round(y(1, k2) - y(1, k2 - 1), 0) 'guanyadors totals gpaux(3, k2) = (y(2, k2) - y(2, k2 - 1)) / 1000 'guanys totals If gpaux(2, k2) <> 0 Then gpaux(4, k2) = gpaux(3, k2) * 1000 / gpaux(2, k2) 'guanys per capita gpaux(5, k2) = (y(3, k2) - y(3, k2 - 1)) / (p(k2, 2) * ntobs(k1)) '%perdedors gpaux(6, k2) = Round(y(3, k2) - y(3, k2 - 1), 0) 'perdedors totals gpaux(7, k2) = (y(4, k2) - y(4, k2 - 1)) / 1000 'guanys totals If gpaux(6, k2) <> 0 Then gpaux(8, k2) = gpaux(7, k2) * 1000 / gpaux(6, k2) 'guanys per capita gpaux(5, k2) = -gpaux(5, k2) 'pel gràfic Next k2 For j1 = 1 To 12 For k2 = 1 To 8 GP(3 * (k2 - 1) + k1, j1) = gpaux(k2, j1) Next k2 Next j1 Next k1 End Sub Private Sub ISD_32COMPARACIO_ESCRIPTURA(ds, GP, nobs, ntobs, s) Dim avisgp(1 To 3) As Boolean, fila As Integer, ig As Integer, i1 As Integer, j1 As Integer, _ llibre As Integer, nom As String, nota(1 To 3) As String, r_f(1 To 2, 1 To 3) As Range ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1 to 2, 1)==> formats del llibre "FORMATS", full "ID" ' ' r_f(1 to 2, 2)==> formats del llibre "SIMCAN", full "(G-P)" ' ' r_f(1 to 2, 3)==> formats del llibre "SIMCAN", full "(G-P)" (només valors)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Application.ScreenUpdating = False nom = ThisWorkbook.Path & "\DADES\Formats.XLSX" Set LLIBRE_FORMATS = Workbooks.Open(nom) llibre = Workbooks.Count Workbooks(llibre).Activate ' llibre "FORMATS" Sheets("ID").Activate Set r_f(1, 1) = Range(Cells(171, 1), Cells(191, 15)) ' Decils Set r_f(2, 1) = Range(Cells(193, 1), Cells(219, 15)) ' Guanyadors ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Crea el full de càlcul on escriu els resultats definitius' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" Call COMUNS_0NOMSFULLS("ID(G-P)") ActiveWorkbook.Unprotect (SECRET) Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate Sheets("ID(G-P)").Activate ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Configura el rang d' escriptura' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' With Range(Cells(1, 1), Cells(45, 15)) .ColumnWidth = 6.43 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 11 End With With Range(Cells(1, 1), Cells(2, 1)) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 End With Cells(1, 1).Value = "IMPOST DE DONACIONS" Cells(2, 1).Value = "COMPARACIÓ SIMULACIÓ-" & COMP(1) & " vs. SIMULACIÓ-" & COMP(2) & _ " (Base de dades: " & ANOID & ")" Set r_f(1, 2) = Range(Cells(3, 1), Cells(23, 15)) ' Decils Rangs d' escriptura Set r_f(2, 2) = Range(Cells(25, 1), Cells(51, 15)) ' Guanyadors Rangs d' escriptura Set r_f(1, 3) = Range(Cells(6, 4), Cells(17, 15)) ' Decils Rangs de valors Set r_f(2, 3) = Range(Cells(28, 4), Cells(51, 15)) ' Guanyadors Rangs de valors ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriu els resultats numèrics' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1, 1).Copy Destination:=r_f(1, 2) r_f(1, 2).Rows(4).Columns(1).Value = "Quota SIMULACIÓ-" & COMP(1) r_f(1, 2).Rows(10).Columns(1).Value = "Quota SIMULACIÓ-" & COMP(2) r_f(1, 2).Rows(16).Columns(1).Value = "SIMULACIÓ-" & COMP(1) r_f(1, 2).Rows(19).Columns(1).Value = "SIMULACIÓ-" & COMP(2) For i1 = 1 To 3 r_f(1, 2).Rows(15 + i1).Columns(4).Value = s(1, i1) r_f(1, 2).Rows(18 + i1).Columns(4).Value = s(2, i1) If s(1, i1) = s(2, i1) Then nota(i1) = "Neutral" ElseIf s(1, i1) > s(2, i1) Then nota(i1) = "Pèrdua en recaptació" Else nota(i1) = "Guany en recaptació" End If r_f(1, 2).Rows(18).Columns(6 + 2 * (i1 - 1)).Value = nota(i1) If nota(i1) <> "Neutral" Then r_f(1, 2).Rows(19).Columns(6 + 2 * (i1 - 1)).Value = s(2, i1) - s(1, i1) Else With Range(Cells(21, 6 + 2 * (i1 - 1)), Cells(23, 6 + 2 * (i1 - 1))) .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "" End With End If r_f(1, 2).Rows(18 + i1).Columns(15).Value = nobs(i1) Next i1 r_f(1, 3).Value = ds r_f(2, 1).Copy Destination:=r_f(2, 2) r_f(2, 3).Value = GP r_f(2, 3).ShrinkToFit = True LLIBRE_FORMATS.Close ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(52, 1)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' Gràfics G-P' ' ' ' ' ' ' ' ' ' ' ' ' ' fila = 51 For i1 = 1 To 3 For j1 = 1 To 12 If Abs(r_f(2, 3).Rows(i1).Columns(j1)) > 0.001 Or _ Abs(r_f(2, 3).Rows(9 + i1).Columns(j1)) > 0.001 Then avisgp(i1) = True Exit For End If Next j1 If avisgp(i1) Then If i1 = 2 And avisgp(2) Then fila = fila + 45 If i1 = 3 And avisgp(3) Then fila = fila + 45 ReDim r_gp(1 To 2, 1 To 4) As Range Set r_gp(1, 1) = r_f(1, 3).Rows(2 * (i1 - 1) + 1) ' Quota Simulació-1' Set r_gp(2, 1) = r_f(1, 3).Rows(2 * (i1 - 1) + 7) ' Quota Simulació-2' Set r_gp(1, 2) = r_f(2, 3).Rows(i1) ' % guanyadors' Set r_gp(2, 2) = r_f(2, 3).Rows(12 + i1) ' % perdedors' Set r_gp(1, 3) = r_f(2, 3).Rows(6 + i1) ' Total guanys' Set r_gp(2, 3) = r_f(2, 3).Rows(18 + i1) ' Total pèrdues' Set r_gp(1, 4) = r_f(2, 3).Rows(9 + i1) ' Mitjana guanyadors' Set r_gp(2, 4) = r_f(2, 3).Rows(21 + i1) ' Mitjana perdedors' With Range(Cells(fila + 1, 1), Cells(fila + 45, 15)) .ColumnWidth = 6.43 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 11 End With With Cells(fila + 1, 1) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "Grups de parentiu: " & IIf(i1 = 1, "1 i 2", IIf(i1 = 2, "3 i 4", "Tots")) End With Call COMUNS_43GRAFICS_GP(fila + 2, ANOID, "ID", "(G-P)", r_gp, 1) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 46, 1)) End If Next i1 For i1 = 1 To Worksheets("ID(G-P)").Shapes.Count - 1 Step 2 Worksheets("ID(G-P)").Shapes(i1).Left = 10 ' Reposicionament imatges Next i1 For i1 = 2 To Worksheets("ID(G-P)").Shapes.Count Step 2 Worksheets("ID(G-P)").Shapes(i1).Left = 280 ' Reposicionament imatges Next i1 ActiveSheet.Protect (SECRET) End Sub Private Sub ISD_40ESCRIPTURA(opcio) Dim fila As Integer, i As Integer, i1 As Integer, j1 As Integer, k1 As Integer, llibre(1 To 2) As Integer, _ nom As String, r_ref(1 To 2) As Range, r_f(1 To 4, 1 To 4) As Range, r_parms(1 To 2) As Range ReDim ns(1 To 3), PAG(1 To 3, 1 To 3), ts(1 To 3, 1 To 2) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1 to 5, 1)==> formats del llibre "FORMATS", full "ID" ' ' r_f(1 to 5, 2)==> formats del llibre "RESULTATS" temporals ' ' r_f(1 to 5, 3)==> formats del llibre "SIMCAN", full "ID(R)" ' ' r_f(1 to 5, 4)==> formats del llibre "SIMCAN", full "ID(R)" (només valors)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Application.ScreenUpdating = False nom = ThisWorkbook.Path & "\DADES\Formats.XLSX" Set LLIBRE_FORMATS = Workbooks.Open(nom) llibre(1) = Workbooks.Count Workbooks(llibre(1)).Activate ' llibre "FORMATS" Sheets("ID").Activate Set r_parms(1) = Range(Cells(1, 1), Cells(24, 15)) ' Paràmetres Set r_f(1, 1) = Range(Cells(26, 1), Cells(48, 12)) ' Descriptiu Set r_f(2, 1) = Range(Cells(50, 1), Cells(58, 14)) ' Límits i mitjana per decils Set r_f(3, 1) = Range(Cells(60, 1), Cells(98, 15)) ' Decils Set r_f(4, 1) = Range(Cells(100, 1), Cells(144, 6)) ' Índexs Set r_ref(1) = Range(Cells(146, 1), Cells(169, 12)) ' Referència ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Crea el full de càlcul on escriu els resultats definitius ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" Call COMUNS_0NOMSFULLS("ID(R)") ActiveWorkbook.Unprotect (SECRET) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriu els resultats de la referència' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' fila = 26 Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate Sheets("ID(R)").Activate Set r_ref(2) = Range(Cells(1, 1), Cells(24, 12)) ' Referencia With r_ref(2) .ColumnWidth = 6.43 .RowHeight = 11 End With r_ref(2).Rows(2).RowHeight = 14 r_ref(1).Copy Destination:=r_ref(2) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila - 1, 1)) For i1 = 1 To UBound(IRESULTS) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Lectura en els arxius temporals de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' nom = NOM_ID_SIMUL & "S" & ANOID & "_" & Trim(Str(IRESULTS(i1))) & ".xlsx" Set LLIBRE_RESULTATS = Workbooks.Open(nom) llibre(2) = Workbooks.Count Workbooks(llibre(2)).Activate ' llibre "RESULTATS" Sheets("PARAMETRES").Activate ' Paràmetres ReDim p(36, 6) For i = 0 To 36 For j1 = 1 To 6 p(i, j1) = Cells(i + 1, j1) Next j1 Next i Sheets("DESCRIPTIU").Activate ' Descriptiu Set r_f(1, 2) = Range(Cells(1, 1), Cells(15, 8)) For i = 1 To 3 ns(i) = Cells(15 + i, 1) ts(i, 1) = Cells(15 + i, 4) ts(i, 2) = Cells(15 + i, 5) For j1 = 1 To 3 PAG(i, j1) = Cells(15 + i, j1 + 5) Next j1 Next i Sheets("LIMITS-MITJANES").Activate ' Límits i mitjanes Set r_f(2, 2) = Range(Cells(1, 1), Cells(6, 12)) Sheets("DECILS-TIPUS").Activate ' Decils i Tipus Set r_f(3, 2) = Range(Cells(1, 1), Cells(36, 12)) Sheets("INDEXS").Activate ' Indexs Set r_f(4, 2) = Range(Cells(1, 1), Cells(42, 2)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriptura en el full definitiu de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" With Range(Cells(fila - 1, 1), Cells(fila - 1 + 169, 15)) ' 163 .ColumnWidth = 6.43 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 10 End With With Range(Cells(fila - 1, 1), Cells(fila - 1, 1)) With .Font .Bold = True .Size = 10 End With .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "SIMULACIÓ-" & IRESULTS(i1) & " (Base de dades: " & ANOID & ")" End With Call ISD_41ESCRIPTURA_PARAMETRES(fila, p, r_parms) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Rangs per a l' escriptura en el llibre SIMCAT full ID(R)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Set r_f(1, 3) = Range(Cells(fila + 25, 1), Cells(fila + 47, 12)) ' Descriptiu Set r_f(1, 4) = Range(Cells(fila + 29, 5), Cells(fila + 43, 12)) Set r_f(2, 3) = Range(Cells(fila + 49, 1), Cells(fila + 57, 14)) ' Límits i mitjanes per decils Set r_f(2, 4) = Range(Cells(fila + 52, 3), Cells(fila + 57, 14)) Set r_f(3, 3) = Range(Cells(fila + 59, 1), Cells(fila + 97, 15)) ' Decils Set r_f(3, 4) = Range(Cells(fila + 62, 4), Cells(fila + 97, 15)) Set r_f(4, 3) = Range(Cells(fila + 99, 1), Cells(fila + 143, 6)) ' Índexs Set r_f(4, 4) = Range(Cells(fila + 102, 5), Cells(fila + 143, 6)) For j1 = 1 To 4 r_f(j1, 1).Copy Destination:=r_f(j1, 3) r_f(j1, 2).Copy: r_f(j1, 4).PasteSpecial xlPasteValues Next j1 With Range(Cells(fila + 90, 1), Cells(fila + 90, 1)) With .Font .Bold = True .Size = 10 End With .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "SIMULACIÓ-" & IRESULTS(i1) & " (Base de dades: " & ANOID & ")" End With For i = 1 To 3 r_f(1, 3).Rows(20 + i).Columns(5).Value = ns(i) r_f(1, 3).Rows(20 + i).Columns(8).Value = ts(i, 1) r_f(1, 3).Rows(20 + i).Columns(9).Value = ts(i, 2) For j1 = 1 To 3 r_f(1, 3).Rows(20 + i).Columns(j1 + 9).Value = PAG(i, j1) Next j1 Next i LLIBRE_RESULTATS.Close ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 58, 1)) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 144, 1)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Rangs dels gràfics ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ReDim r_g(1 To 3, 1 To 4) As Range For k1 = 1 To 3 j1 = 2 * (k1 - 1) Set r_g(1, 1) = r_f(3, 4).Rows(2 + j1) ' BI acum. (sim) Set r_g(2, 1) = r_f(3, 4).Rows(26 + j1) ' QT acum. (sim) Set r_g(3, 1) = r_f(3, 4).Rows(26 + j1) ' QT acum. (sim) Set r_g(1, 2) = r_f(3, 4).Rows(14 + j1) ' BL acum. (sim) Set r_g(2, 2) = r_f(3, 4).Rows(26 + j1) ' QT acum. (sim) Set r_g(3, 2) = r_f(3, 4).Rows(26 + j1) ' QT acum. (sim) Set r_g(1, 3) = r_f(3, 4).Rows(30 + k1) ' QT s/BI (sim) Set r_g(1, 4) = r_f(3, 4).Rows(33 + k1) ' QT s/BL (sim) Call ISD_42ESCRIPTURA_GRAFICS(fila + 145 + (k1 - 1) * 46, k1, r_g, IRESULTS(i1)) ' 139 Next k1 fila = fila + 286 ' 280 If i1 < UBound(IRESULTS) Then ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila - 1, 1)) Next i1 LLIBRE_FORMATS.Close Call COMUNS_5IMPRESSIO("ID", "R") End Sub Private Sub ISD_41ESCRIPTURA_PARAMETRES(fila, p, r_parms) Dim i1 As Integer, j1 As Integer Set r_parms(2) = Range(Cells(fila, 1), Cells(fila + 24, 15)) ' Paràmetres r_parms(1).Copy Destination:=r_parms(2) With r_parms(2) .Font.Size = 8 For i1 = 1 To p(0, 2) ' tarifa Grups 1 i 2 For j1 = 1 To 3 .Rows(3 + i1).Columns(j1).Value = p(19 + i1, j1) Next j1 Next i1 If p(0, 2) <> 16 Then With Range(Cells(fila + p(0, 2) + 3, 1), Cells(fila + 18, 3)) .Interior.Pattern = xlDown .MergeCells = True .Value = "" End With With Range(Cells(fila + p(0, 2) + 2, 1), Cells(fila + p(0, 2) + 2, 3)) With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With End With End If For i1 = 1 To p(0, 3) ' tarifa Grups 3 i 4 For j1 = 1 To 3 .Rows(3 + i1).Columns(3 + j1).Value = p(19 + i1, j1 + 3) Next j1 Next i1 If p(0, 3) <> 16 Then With Range(Cells(fila + p(0, 3) + 3, 4), Cells(fila + 18, 6)) .Interior.Pattern = xlDown .MergeCells = True .Value = "" End With With Range(Cells(fila + p(0, 3) + 2, 4), Cells(fila + p(0, 3) + 2, 6)) With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With End With End If j1 = Application.Max(p(0, 2), p(0, 3)) If j1 <> 16 Then For i1 = j1 + 1 To 16 Cells(fila + 2 + i1, 4).Borders(xlEdgeLeft).LineStyle = xlNone Next i1 End If For i1 = 2 To 4 For j1 = 2 To 4 ' coeficients correctors .Rows(20 + i1).Columns(j1 - 1).Value = p(15 + i1, j1) Next j1 Next i1 If p(36, 1) <> 0 Or p(36, 2) <> 0 Or p(36, 3) <> 0 Or p(36, 4) <> 0 Then For j1 = 2 To 4 ' bonificacions quota .Rows(21).Columns(j1 + 2).Value = p(36, j1) Next j1 Else With Range(Cells(fila + 19, 4), Cells(fila + 21, 6)) .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Interior.Pattern = xlDown .MergeCells = True .Value = "" End With Cells(fila + 18, 7).Borders(xlEdgeLeft).LineStyle = xlNone End If For i1 = 1 To 15 ' reduccions .Rows(i1 + 3).Columns(13).Value = p(i1, 1) Next i1 .Rows(8).Columns(14).Value = p(5, 2) ' NR .Rows(8).Columns(15).Value = p(5, 3) .Rows(10).Columns(14).Value = p(7, 2) ' HB .Rows(10).Columns(15).Value = p(7, 3) .Rows(11).Columns(14).Value = p(8, 2) ' DB .Rows(11).Columns(15).Value = p(8, 3) End With End Sub Private Sub ISD_42ESCRIPTURA_GRAFICS(fila, k1, r_g, sim) Dim i1 As Integer, i2 As Integer, j1 As Integer, mmax As Double, nom() As String, s_r() As Boolean ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriptura en el full definitiu de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' With Range(Cells(fila - IIf(k1 = 1, 1, IIf(k1 = 2, 0, -1)), 1), Cells(fila + 46 - IIf(k1 = 1, 1, IIf(k1 = 2, 0, -1)), 15)) .ColumnWidth = 6.43 .Interior.ColorIndex = 2 .RowHeight = 10 End With With Range(Cells(fila - IIf(k1 = 1, 1, IIf(k1 = 2, 0, -1)), 1), Cells(fila - IIf(k1 = 1, 1, IIf(k1 = 2, 0, -1)), 1)) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "GRÀFICS DE LA SIMULACIÓ-" & sim & " (Base de dades: " & ANOID & _ ", Grups de parentiu: " & IIf(k1 = 1, "1 i 2)", IIf(k1 = 2, "3 i 4)", "Tots)")) End With ReDim nom(1 To 4, 1 To 2), s_r(1 To 5, 1 To 3) For i1 = 1 To 2 nom(1, i1) = "Sim-" & sim & IIf(i1 = 1, "(BI)", "(BL)") nom(2, i1) = "Sim-" & sim & "(QT)" nom(3, i1) = "Sim-" & sim & "(QT relativa)" nom(4, i1) = "Equitat" Next i1 mmax = Round(Application.Max(r_g(1, 3), r_g(1, 4)), 2) If mmax = 0 Then mmax = 0.001 Call COMUNS_41GRAFICS_CORBESLORENZ(fila + IIf(k1 = 1, 0, IIf(k1 = 2, 1, 2)), False, "ID", nom, r_g, s_r) ' Lorenz Call COMUNS_42GRAFICS_TIPUS(fila + 23 + IIf(k1 = 1, 0, IIf(k1 = 2, 1, 2)), False, "ID", 0, mmax, r_g, s_r, sim) ' Tipus efectius If k1 = 2 Then ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 47, 1)) If k1 = 3 Then ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 48, 1)) If k1 = 3 Then For i1 = 1 To Worksheets("ID(R)").Shapes.Count - 1 Step 2 Worksheets("ID(R)").Shapes(i1).Left = 20 ' Reposicionament de les imatges' Next i1 For i1 = 2 To Worksheets("ID(R)").Shapes.Count Step 2 Worksheets("ID(R)").Shapes(i1).Left = 310 ' Reposicionament de les imatges' Next i1 End If End Sub Private Sub IT_10PARAMETRES(opcio As Integer) Dim i1 As Integer ReDim aux(100) As Integer, aux1(1000), tram(8) As Integer For i1 = 100 To 0 Step -1 aux(100 - i1) = i1 If i1 <= 4 Then tram(4 - i1) = i1 + 1 Next i1 For i1 = -500 To 500 aux1(500 - i1) = i1 / 10 Next i1 If ISIMULS(4) <> 0 Then ReDim sims(1 To ISIMULS(4)) For i1 = ISIMULS(4) To 1 Step -1 sims(ISIMULS(4) - i1 + 1) = CIT(i1) Next i1 End If ERR_LEC = True Do While ERR_LEC With ITPOAJDOS .Caption = "SIMCAN-ITPOOSAJD: Tarifes" & " (Base de dades: " & ANOIT & ")" .ListBox111.List = tram .ListBox_TUB.List = aux .ListBox_TPO.List = aux1 .ListBox_OS.List = aux1 .ListBox_AJD.List = aux1 .EmplenaValors.Value = True If ISIMULS(4) <> 0 Then .ListBox_SimulRef.List = sims .SimulRef.Visible = True End If .Show End With If SORTIR Then Exit Sub Loop End Sub Private Sub IT_20SIMULACIO(opcio As Integer) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' Variables d' interès ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ID Identificador ' ' FASE data meritació TPO: anterior a 30/06/2010=1, entre 01/07/2010 i 31/07/2013=2, a partir de 01/08/2013=3 ' ' AUR: anterior a 30/01/2014=1, entre 01/02/2014 i 31/12/2014=2. a partir de 01/01/2015=3 ' ' OS: sempre 1 ' ' AJD: anterior a 30/06/2010=1, entre 01/07/2010 i 23/03/2012=2, a partir de 24/03/2012=3 ' ' CODI_IMPOST (1=TPO, 2=OS, 3=AJD) ' ' CODI_TARIFA codi tarifa ' ' CODI_BONIFICACIO ' ' tpo tarifes numerades TPO ' ' os tarifes numerades OS ' ' ajd tarifes numerades AJD ' ' BI Base imposable ' ' RED percentatge reducció ' ' BL Base liquidable ' ' BON_IT percentatge bonificació ' ' QR quota tributària ' ' especial indicador tarifes TUB, TRT, TV0; en FASE=3 i V48 o V57 >1000000 d'euros (només a partir de 2017) ' ' V48 valor Bé 1 (només a partir de 2017) ' ' V57 valor Bé 2 (només a partir de 2017) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Declaracions de variables del fitxer de lectura' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim AJD As Integer, BI As Double, bl As Double, BON_IT As Double, CODI_BONIFICACIO As Integer, CODI_IMPOST As String, CODI_TARIFA As String, _ FASE As Integer, ID As Long, OS As Integer, QR As Double, RED As Double, tpo As Integer, V48 As Double, V57 As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Declaracions de variables utilitzades ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim aux, i1 As Long, j1 As Integer, j2 As Integer, j3 As Integer, k1 As Integer, k2 As Integer, QRb As Double ReDim l(1 To 44) As Long, SUMA(1 To 2, 1 To 3), VT(57, 10), vx(1 To 44, 1 To 6), y(1 To 3) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Primera lectura de dades' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' NT1 = 0 NT2 = 0 NT3 = 0 Open NOM_IT_DADES & ANOIT & ".dat" For Input As #1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Open ThisWorkbook.Path & "\COMPROVACIONS\ITPOOSAJD\ERRORS.TXT" For Output As #10 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Input #1, N1, N2, N3 N = N1 + N2 + N3 ReDim IND(1 To N, 1 To 1), X(1 To N, 1 To 3) For i1 = 1 To N Input #1, ID, FASE, CODI_IMPOST, CODI_TARIFA, CODI_BONIFICACIO, tpo, OS, AJD, BI, RED, bl, BON_IT, QR, V48, V57 y(3) = 1 ' pes fictici BON_IT = (1 - (BON_IT / 100)) If i1 <= N1 Then BI = BI * PROJ(1) bl = bl * PROJ(1) For j1 = 1 To 17 If tpo = j1 Then l(j1) = l(j1) + 1 If tpo <= 3 Then Call IT_20TUB_TRT_TV0(BI, bl, BON_IT, CODI_BONIFICACIO, CODI_TARIFA, QRb, V48, V57) Else QRb = bl * TIPUS_TPO(j1) * BON_IT 'Tarifes TPO (Projectant BI) If CODI_BONIFICACIO = 441 And BI > 500000 Then QRb = bl * TIPUS_TPO(j1) 'Rectificació CODI_BONIFICACIO=442 If CODI_BONIFICACIO = 442 And BI > 100000 Then QRb = (bl - 100000) * TIPUS_TPO(j1) 'Rectificació CODI_BONIFICACIO=442 If CODI_TARIFA = "TUB" And BON_IT = 0.3 Then QRb = bl * TIPUS_TPO(j1) * (1 - BON_IT_TUB) 'Rectificació Bonificació 70% TUB End If End If Next j1 NT1 = NT1 + y(3) ElseIf i1 <= N1 + N2 Then BI = BI * PROJ(2) bl = bl * PROJ(2) For j1 = 1 To 7 If OS = j1 Then l(18 + j1) = l(18 + j1) + 1 QRb = bl * TIPUS_OS(j1) * BON_IT ' Tarifes OS (Projectant la BI) If CODI_BONIFICACIO = 441 And BI > 500000 Then ' Rectificació CODI_BONIFICACIo=441 QRb = bl * TIPUS_OS(j1) End If If CODI_BONIFICACIO = 442 And BI > 100000 Then ' Rectificació CODI_BONIFICACIo=442 QRb = (bl - 100000) * TIPUS_OS(j1) End If End If Next j1 NT2 = NT2 + y(3) Else BI = BI * PROJ(3) bl = bl * PROJ(3) For j1 = 1 To 17 If AJD = j1 Then l(26 + j1) = l(26 + j1) + 1 QRb = bl * TIPUS_AJD(j1) * BON_IT ' Tarifes AJD (Projectant la BI) If CODI_BONIFICACIO = 441 And BI > 500000 Then ' Rectificació CODI_BONIFICACIo=441 QRb = bl * TIPUS_AJD(j1) End If If CODI_BONIFICACIO = 442 And BI > 100000 Then ' Rectificació CODI_BONIFICACIo=442 QRb = (bl - 100000) * TIPUS_AJD(j1) End If End If Next j1 NT3 = NT3 + y(3) End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If Abs(QR - QRb) > 1 Then Write #10, ID, CODI_IMPOST, CODI_TARIFA, tpo, os, ajd, BI, BL, BON_IT, QR, QRb ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' j2 = IIf(i1 <= N1, 18, IIf(i1 <= N1 + N2, 26, 44)) j3 = IIf(i1 <= N1, 0, IIf(i1 <= N1 + N2, 18, 26)) For k1 = 1 To 2 y(k1) = IIf(k1 = 1, BI, QRb) k2 = 3 * (k1 - 1) If y(k1) <> 0 Then vx(j2, k2 + 1) = vx(j2, k2 + 1) + (y(k1) * y(3)) vx(j2, k2 + 2) = vx(j2, k2 + 2) + ((y(k1) ^ 2) * (y(3) ^ 2)) vx(j2, k2 + 3) = vx(j2, k2 + 3) + 1 For j1 = 1 To IIf(i1 <= N1, 17, IIf(i1 <= N1 + N2, 7, 17)) If IIf(i1 <= N1, tpo, IIf(i1 <= N1 + N2, OS, AJD)) = j1 Then vx(j1 + j3, k2 + 1) = vx(j1 + j3, k2 + 1) + (y(k1) * y(3)) vx(j1 + j3, k2 + 2) = vx(j1 + j3, k2 + 2) + ((y(k1) ^ 2) * (y(3) ^ 2)) vx(j1 + j3, k2 + 3) = vx(j1 + j3, k2 + 3) + 1 End If Next j1 End If Next k1 X(i1, 1) = BI X(i1, 2) = QRb X(i1, 3) = 1 Next i1 Close #1 ' ' ' ' ' ' ' ' ' ' ' Close #10 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda(Descriptiu) a VT)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To 17 VT(j1, 1) = IT_TARIFA_TPO(j1) VT(j1, 2) = l(j1) Next j1 VT(18, 2) = N1 For j1 = 1 To 7 VT(18 + j1, 1) = IT_TARIFA_OS(j1) VT(18 + j1, 2) = l(18 + j1) Next j1 VT(26, 2) = N2 For j1 = 1 To 17 VT(26 + j1, 1) = IT_TARIFA_AJD(j1) VT(26 + j1, 2) = l(26 + j1) Next j1 VT(44, 2) = N3 For k1 = 1 To 2 k2 = 3 * (k1 - 1) For j1 = 1 To 44 VT(j1, IIf(k1 = 1, 3, 7)) = vx(j1, k2 + 1) If vx(j1, k2 + 1) <> 0 Then If vx(j1, k2 + 2) - ((vx(j1, k2 + 1) ^ 2) / vx(j1, k2 + 3)) > 0 Then VT(j1, IIf(k1 = 1, 4, 8)) = Sqr(vx(j1, k2 + 2) - ((vx(j1, k2 + 1) ^ 2) / vx(j1, k2 + 3))) VT(j1, IIf(k1 = 1, 5, 9)) = VT(j1, IIf(k1 = 1, 3, 7)) - 1.96 * VT(j1, IIf(k1 = 1, 4, 8)) VT(j1, IIf(k1 = 1, 6, 10)) = VT(j1, IIf(k1 = 1, 3, 7)) + 1.96 * VT(j1, IIf(k1 = 1, 4, 8)) End If End If Next j1 Next k1 For j1 = 1 To 44 If VT(j1, 2) = 0 Then For k1 = 3 To 10 VT(j1, k1) = "----" Next k1 End If If VT(j1, 2) < 5 Then For k1 = 4 To 10 If k1 <> 7 Then VT(j1, k1) = "----" Next k1 End If If VT(j1, 5) < 0 Then For k1 = 4 To 6 VT(j1, k1) = "----" Next k1 End If If VT(j1, 9) < 0 Then For k1 = 8 To 10 VT(j1, k1) = "----" Next k1 End If Next j1 SUMA(1, 1) = VT(18, 3) SUMA(2, 1) = VT(18, 7) SUMA(1, 2) = VT(26, 3) SUMA(2, 2) = VT(26, 7) SUMA(1, 3) = VT(44, 3) SUMA(2, 3) = VT(44, 7) Call IT_21ORDENA(0) Call IT_22INDEXS(3) End Sub Private Sub IT_20TUB_TRT_TV0(BI, bl, BON_IT, CODI_BONIFICACIO, CODI_TARIFA, QRb, V48, V57) Dim i1 As Integer, base_e As Double, quota_e As Double, tipus_e As Double '''''''''''''''''''''''''''''''''''''''''''''''''' 'Càlcul preliminar sobre trams i tipus impositius' '''''''''''''''''''''''''''''''''''''''''''''''''' ReDim tt(1 To NTRAMSTUB - IIf(NTRAMSTUB = 1, 0, 1)) As Double tt(1) = TRAMSTUB(1) * TIPUSTUB(1) If NTRAMSTUB > 2 Then For i1 = 2 To NTRAMSTUB - 1 tt(i1) = tt(i1 - 1) + ((TRAMSTUB(i1) - TRAMSTUB(i1 - 1)) * TIPUSTUB(i1)) Next i1 End If base_e = Application.Max(BI, V48, V57) If base_e <= TRAMSTUB(1) Then tipus_e = TIPUSTUB(1) Else If NTRAMSTUB = 1 Then tipus_e = TIPUSTUB(1) Else If base_e <= TRAMSTUB(1) Then quota_e = base_e * TIPUSTUB(1) If NTRAMSTUB > 2 Then For i1 = 2 To NTRAMSTUB - 1 If base_e > TRAMSTUB(i1 - 1) And base_e <= TRAMSTUB(i1) Then quota_e = tt(i1 - 1) + ((base_e - TRAMSTUB(i1 - 1)) * TIPUSTUB(i1)) Next i1 End If If base_e > TRAMSTUB(NTRAMSTUB - 1) Then quota_e = tt(NTRAMSTUB - 1) + ((base_e - TRAMSTUB(NTRAMSTUB - 1)) * TIPUSTUB(NTRAMSTUB)) tipus_e = Int(quota_e / base_e * 10000) / 10000 End If End If QRb = bl * tipus_e * BON_IT 'Tarifes TPO (Projectant BI) If CODI_BONIFICACIO = 441 And BI > 500000 Then QRb = bl * tipus_e 'Rectificació CODI_BONIFICACIO=442 If CODI_BONIFICACIO = 442 And BI > 100000 Then QRb = (bl - 100000) * tipus_e 'Rectificació CODI_BONIFICACIO=442 If CODI_TARIFA = "TUB" And BON_IT = 0.3 Then QRb = bl * tipus_e * (1 - BON_IT_TUB) 'Rectificació Bonificació 70% TUB End Sub Private Sub IT_21ORDENA(opcio As Integer) Dim i1 As Long, i2 As Long, i3 As Long, k1 As Integer ReDim y(1 To N) For k1 = 1 To 3 ' k1=1 ==>TPO k1=2 ==>OS k1=3 ==>AJD i2 = IIf(k1 = 1, 1, IIf(k1 = 2, N1 + 1, N1 + N2 + 1)) i3 = IIf(k1 = 1, N1, IIf(k1 = 2, N1 + N2, N1 + N2 + N3)) For i1 = i2 To i3 y(i1) = X(i1, 1) + ((i1 / N) ^ 0.001) ' Suma quantitat per eliminar repeticions IND(i1, 1) = i1 Next i1 Call COMUNS_2ORDENA_AUX(i2, i3, 1) ' Crida a la rutina per a ordenar Next k1 End Sub Private Sub IT_22INDEXS(pes) ' pes=posicio pes (3) Dim aconc, agini, asuit, auxm1, auxm2, auxmp, auxn As Long, _ auxnt, axx_b, axx_p, c, daux(1 To 4), g, i1 As Long, _ i2 As Long, i3 As Long, j1 As Integer, k, s, sxx_b As Double ReDim xx_b(1 To N), xx_p(1 To N) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula: xx_b(1 to N) = (BI * factor) acumulades / s(variables * factor) ' Calcula: xx_p(1 to N) = població acumulada/NT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To 3 i2 = IIf(j1 = 1, 1, IIf(j1 = 2, N1 + 1, N1 + N2 + 1)) i3 = IIf(j1 = 1, N1, IIf(j1 = 2, N1 + N2, N1 + N2 + N3)) auxn = IIf(j1 = 1, N1, IIf(j1 = 2, N2, N3)) auxnt = IIf(j1 = 1, NT1, IIf(j1 = 2, NT2, NT3)) axx_b = 0 If SUMA(1, j1) <> 0 Then For i1 = i2 To i3 axx_b = axx_b + (X(IND(i1, 1), 1) * X(IND(i1, 1), pes)) xx_b(i1) = axx_b / SUMA(1, j1) ' BI Next i1 End If axx_p = 0 For i1 = i2 To i3 axx_p = axx_p + X(IND(i1, 1), pes) xx_p(i1) = axx_p / auxnt ' pes Next i1 auxm1 = SUMA(1, j1) / auxnt auxm2 = SUMA(2, j1) / auxnt auxmp = auxnt / auxn agini = 0 sxx_b = 0 If SUMA(1, j1) <> 0 Then For i1 = i2 To i3 daux(1) = X(IND(i1, 1), 1) - auxm1 daux(2) = xx_p(i1) - auxmp daux(3) = X(IND(i1, 1), pes) agini = agini + (daux(1) * daux(2) * daux(3)) sxx_b = sxx_b + xx_b(i1) ' s.acum. BI Next i1 If agini <> 0 Then g = 2 / auxm1 * (agini / auxnt) ' gini End If aconc = 0 asuit = 0 If SUMA(2, j1) <> 0 Then For i1 = i2 To i3 daux(1) = X(IND(i1, 1), 2) - auxm2 daux(2) = xx_p(i1) - auxmp daux(3) = X(IND(i1, 1), pes) daux(4) = xx_b(i1) - (sxx_b / auxn) aconc = aconc + (daux(1) * daux(2) * daux(3)) asuit = asuit + (daux(1) * daux(4) * daux(3)) Next i1 If aconc <> 0 Then c = 2 / auxm2 * (aconc / auxnt) ' concentració k = c - g ' kakwani s = (2 * (asuit / auxnt) / auxm2) - g ' suits End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda els resultats(Índexs) a VT' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' VT(45, 0) = "Índexs" VT(44 + j1, 1) = g VT(47 + j1, 1) = c VT(50 + j1, 1) = k VT(53 + j1, 1) = s Next j1 End Sub Private Sub IT_30COMPARACIO(opcio As Integer) Dim nom As String, llibre(1 To 3) As Integer, llibre_r(1 To 3) As Workbook, r_f(7) As Range ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(0) ==> formats del llibre QUOTA Simulació-COMP(1) Tarifes ' ' r_f(1) ==> formats del llibre QUOTA Simulació-COMP(1) ' ' r_f(2) ==> formats del llibre QUOTA Simulació-COMP(2) ' ' r_f(1) ==> formats del llibre "FORMATS", full "ITPOOSAJD" ' ' r_f(4) ==> formats del llibre "SIMCAN", full "ITPOOSAJD(G-P)" ' ' r_f(5) ==> formats del llibre "SIMCAN", full "ITPOOSAJD(G-P)" (només valors)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Application.ScreenUpdating = False nom = NOM_IT_SIMUL & "S" & ANOIT & "_" & Trim(Str(COMP(1))) & ".xlsx" Set llibre_r(1) = Workbooks.Open(nom) llibre(1) = Workbooks.Count Workbooks(llibre(1)).Activate ' llibre Simulació COMP(1) Sheets("DESCRIPTIU").Activate Set r_f(0) = Range(Cells(1, 1), Cells(44, 1)) ' Tarifes Set r_f(1) = Range(Cells(1, 7), Cells(44, 7)) ' Quota COMP(1) N = Cells(Range(Cells(1, 2), Cells(1, 2)).End(xlDown).Row, 2) ' Recupera el nombre de liquidacions total nom = NOM_IT_SIMUL & "S" & ANOIT & "_" & Trim(Str(COMP(2))) & ".xlsx" Set llibre_r(2) = Workbooks.Open(nom) llibre(2) = Workbooks.Count Workbooks(llibre(2)).Activate ' llibre Simulació COMP(2) Sheets("DESCRIPTIU").Activate Set r_f(2) = Range(Cells(1, 7), Cells(44, 7)) ' Quota COMP(2) nom = ThisWorkbook.Path & "\DADES\Formats.XLSX" Set llibre_r(3) = Workbooks.Open(nom) llibre(3) = Workbooks.Count Workbooks(llibre(3)).Activate ' llibre "FORMATS" Sheets("ITPOOSAJD").Activate Set r_f(3) = Range(Cells(140, 1), Cells(187, 6)) ' Comparació ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Crea el full de càlcul on escriu els resultats definitius' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" Call COMUNS_0NOMSFULLS("ITPOOSAJD(G-P)") ActiveWorkbook.Unprotect (SECRET) Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate Sheets("ITPOOSAJD(G-P)").Activate ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Configura el rang d' escriptura' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' With Range(Cells(1, 1), Cells(48, 6)) .Font.Bold = True .Font.Name = "Arial" .Font.Size = 8 .RowHeight = 10 End With Cells(1, 1).RowHeight = 12 Set r_f(4) = Range(Cells(2, 1), Cells(49, 6)) Set r_f(5) = Range(Cells(5, 2), Cells(48, 2)) Set r_f(6) = Range(Cells(5, 3), Cells(48, 3)) Set r_f(7) = Range(Cells(5, 4), Cells(48, 4)) Cells(1, 1).Value = "COMPARACIÓ SIMULACIÓ-" & COMP(1) & " vs. SIMULACIÓ-" & COMP(2) & " (Base de dades: " & ANOIT & ")" r_f(3).Copy Destination:=r_f(4) ' Format COMPARACIÓ r_f(0).Copy: r_f(5).PasteSpecial xlPasteValues ' Tarifes r_f(1).Copy: r_f(6).PasteSpecial xlPasteValues ' Quota COMP(1) r_f(2).Copy: r_f(7).PasteSpecial xlPasteValues ' Quota COMP(2) Cells(4, 3).Value = "Simulació-" & COMP(1) Cells(4, 4).Value = "Simulació-" & COMP(2) Cells(22, 2) = "Total" Cells(30, 2) = "Total" Cells(48, 2) = "Total" llibre_r(1).Close llibre_r(2).Close llibre_r(3).Close Call COMUNS_5IMPRESSIO("ITPOOSAJD", "G-P") End Sub Private Sub IT_40ESCRIPTURA(opcio) Dim fila As Integer, i As Integer, i1 As Integer, j1 As Integer, _ llibre(1 To 2) As Integer, nom As String, _ r_ref(1 To 3) As Range, r_f(1 To 2, 1 To 4) As Range, r_parms(1 To 2) As Range ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1 to 2, 1) ==> formats del llibre "FORMATS", full "ITPOOSAJD" ' ' r_f(1 to 2, 2) ==> formats del llibre "RESULTATS" temporals ' ' r_f(1 to 2, 3) ==> formats del llibre "SIMCAN", full "ITPOOSAJD(R)" ' ' r_f(1 to 2, 4) ==> formats del llibre "SIMCAN", full "ITPOOSAJD(R)" (només valors)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Application.ScreenUpdating = False nom = ThisWorkbook.Path & "\DADES\Formats.XLSX" Set LLIBRE_FORMATS = Workbooks.Open(nom) llibre(1) = Workbooks.Count Workbooks(llibre(1)).Activate ' llibre "FORMATS" Sheets("ITPOOSAJD").Activate Set r_parms(1) = Range(Cells(1, 1), Cells(23, 9)) ' Paràmetres Set r_f(1, 1) = Range(Cells(25, 1), Cells(73, 11)) ' Descriptiu Set r_f(2, 1) = Range(Cells(75, 1), Cells(88, 5)) ' Indexs Set r_ref(1) = Range(Cells(90, 1), Cells(138, 5)) ' Referència ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Crea el full de càlcul on escriu els resultats definitius' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" Call COMUNS_0NOMSFULLS("ITPOOSAJD(R)") ActiveWorkbook.Unprotect (SECRET) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriu els resultats de la referència ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate Sheets("ITPOOSAJD(R)").Activate Set r_ref(2) = Range(Cells(1, 1), Cells(49, 11)) With r_ref(2) .ColumnWidth = 11 .RowHeight = 10 End With r_ref(1).Copy Destination:=r_ref(2) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(50, 1)) fila = 51 For i1 = 1 To UBound(IRESULTS) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Lectura en els arxius temporals de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' nom = NOM_IT_SIMUL & "S" & ANOIT & "_" & Trim(Str(IRESULTS(i1))) & ".xlsx" Set LLIBRE_RESULTATS = Workbooks.Open(nom) llibre(2) = Workbooks.Count Workbooks(llibre(2)).Activate ' llibre "RESULTATS" Sheets("PARAMETRES").Activate ' Paràmetres ReDim p(1 To 19 + Cells(1, 2) + 1, 1 To 6) For i = 1 To UBound(p, 1) For j1 = 1 To UBound(p, 2) p(i, j1) = Cells(i, j1) Next j1 Next i Sheets("DESCRIPTIU").Activate ' Descriptiu Set r_f(1, 2) = Range(Cells(1, 1), Cells(44, 10)) Sheets("INDEXS").Activate ' Indexs Set r_f(2, 2) = Range(Cells(1, 1), Cells(12, 1)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriptura en el full definitiu de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" With Range(Cells(fila - 1, 1), Cells(fila + 87, 11)) .ColumnWidth = 11 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 11 End With With Range(Cells(fila - 1, 1), Cells(fila - 1, 1)) .Font.Bold = True .HorizontalAlignment = xlLeft .RowHeight = 12 .Value = "SIMULACIÓ-" & IRESULTS(i1) & " (Base de dades: " & ANOIT & ")" End With Call IT_41ESCRIPTURA_PARAMETRES(fila, p, r_parms) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Rangs per a l' escriptura en el llibre SIMCAT full IT(R)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Set r_f(1, 3) = Range(Cells(fila + 24, 1), Cells(fila + 72, 11)) ' Descriptiu Set r_f(1, 4) = Range(Cells(fila + 28, 2), Cells(fila + 71, 11)) Set r_f(2, 3) = Range(Cells(fila + 74, 1), Cells(fila + 87, 5)) ' Índexs Set r_f(2, 4) = Range(Cells(fila + 76, 5), Cells(fila + 87, 5)) For j1 = 1 To 2 r_f(j1, 1).Copy Destination:=r_f(j1, 3) r_f(j1, 2).Copy: r_f(j1, 4).PasteSpecial xlPasteValues Next j1 LLIBRE_RESULTATS.Close ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 88, 1)) fila = fila + 89 Next i1 LLIBRE_FORMATS.Close Call COMUNS_5IMPRESSIO("ITPOOSAJD", "R") End Sub Private Sub IT_41ESCRIPTURA_PARAMETRES(fila, p, r_parms) Dim i1 As Integer, j1 As Integer Set r_parms(2) = Range(Cells(fila, 1), Cells(fila + 22, 9)) ' Paràmetres r_parms(1).Copy Destination:=r_parms(2) With r_parms(2) For i1 = 1 To 14 ' TPO tarifes tipus únic .Rows(i1 + 3).Columns(2).Value = p(i1 + 4, 2) Next i1 For i1 = 1 To 7 ' OS tarifes tipus únic .Rows(i1 + 3).Columns(7).Value = p(i1 + 1, 4) Next i1 For i1 = 1 To 17 ' AJD tarifes tipus únic .Rows(i1 + 3).Columns(9).Value = p(i1 + 1, 6) Next i1 For i1 = 1 To p(1, 2) For j1 = 1 To 3 .Rows(i1 + 4).Columns(j1 + 2).Value = p(20 + i1, j1) Next j1 Next i1 If p(1, 2) <> 5 Then ' For i1 = 1 to 5-p(1, 2) To 5 ' With Range(Cells(fila + 9 - i1, 3), Cells(fila + 9 - i1, 5)) ' .Interior.Pattern = xlCrissCross ' .MergeCells = True ' End With ' Next i1 With Range(Cells(fila + 4 + p(1, 2), 3), Cells(fila + 8, 5)) .Interior.Pattern = xlCrissCross .MergeCells = True End With End If .Rows(10).Columns(5).Value = p(19, 2) ' Bonificació Tarifa TUB If p(20, 1) <> 1 Or p(20, 2) <> 1 Or p(20, 3) <> 1 Then ' Projeccions .Rows(21).Columns(4) = IIf(p(20, 1) <> 1, p(20, 1) - 1, "' ----") .Rows(22).Columns(4) = IIf(p(20, 2) <> 1, p(20, 2) - 1, "' ----") .Rows(23).Columns(4) = IIf(p(20, 3) <> 1, p(20, 3) - 1, "' ----") Else With Range(Cells(fila + 20, 6), Cells(fila + 22, 7)) .Interior.Pattern = xlCrissCross .Font.Bold = True .HorizontalAlignment = xlCenter .MergeCells = True .Value = "SENSE PROJECCIONS" With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium End With End With With Cells(fila + 21, 5) .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Interior.Pattern = xlCrissCross .Value = "" End With End If End With End Sub Private Sub IPPF_10PARAMETRES(opcio As Integer) Dim i1 As Integer ReDim lim(8) As Integer, aproj(300), tram(11) As Integer For i1 = -150 To 150 If i1 >= 0 And i1 <= 8 Then lim(8 - i1) = 10 * (i1 + 1) If i1 >= 0 And i1 <= 11 Then tram(11 - i1) = i1 + 1 aproj(150 - i1) = i1 / 10 Next i1 If ISIMULS(5) <> 0 Then ReDim sims(1 To ISIMULS(5)) For i1 = ISIMULS(5) To 1 Step -1 sims(ISIMULS(5) - i1 + 1) = CIPPF(i1) Next i1 End If PAGINA = -1 TORNA: PAGINA = PAGINA + 1 ERR_LEC = True Do While ERR_LEC With IPPF .MultiPage1.Value = PAGINA If .MultiPage1.Value = 0 Then .Caption = "SIMCAN-IPPF: Determinació dels béns i drets exempts i dels mínims exempts" If .MultiPage1.Value = 1 Then .Caption = "SIMCAN-IPPF: Trams i tipus impositius. Reducció personal. Connexió IRPF. Projeccions" .Caption = .Caption & " (Base de dades: " & ANOIPPF & ")" If ISIMULS(5) <> 0 Then .ListBox_SimulRef.List = sims .SimulRef.Visible = True End If .ListBox22.List = tram .ListBox231.List = lim .ListBox232.List = lim .ListBox241.List = aproj .ListBox242.List = aproj .ListBox243.List = aproj .Llei.Value = True .Show End With If SORTIR Then Exit Sub Loop If PAGINA < 1 Then GoTo TORNA If PAGINA = 1 Then Exit Sub End Sub Private Sub IPPF_20SIMULACIO(opcio As Integer) Dim i1 As Long, i2 As Long, it As Integer, j1 As Integer ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Càlcul preliminar sobre trams i tipus impositius' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ReDim tt(1 To NTRAMS - IIf(NTRAMS <> 1, 1, 0)) As Double tt(1) = T(1) * TIPUS(1) If NTRAMS > 2 Then For it = 2 To NTRAMS - 1 tt(it) = tt(it - 1) + ((T(it) - T(it - 1)) * TIPUS(it)) Next it End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' 'Open ThisWorkbook.Path & "\COMPROVACIONS\IPPF\BI-BL-QI.txt" For Output As #100 ' Write #100, "ID", "IDc", "PatrimTotal", "BI simulada", "BL simulada", "BLc simulada", _ ' "Quota Final simulada", "Quota ref.", "Guanyen", _ ' "v29", "v29c", "v30", "v31", "v32", "v33", "v34", "v35", "v36", "v37", "v38", _ ' "v39", "v40", "v41", "v42", "v43", "v44", "v50", "v60", "v63", "VNBIM", "VNBIMc" ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Write #100, "ID", "IDc", "BI", "BL", "Quota integra" ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' 1a. Lectura de dades: càlculs fins a la quota íntegra abans de la connexió amb l' IRPF' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim aux, ID_SP As Long, ID_SPc As Long, MINUS As Integer, VNBIM As Double Open NOM_IPPF_DADES & ANOIPPF & ".dat" For Input As #1 Input #1, N, aux ReDim X(1 To N, 9), c(1 To N, 1 To 4), SP(1 To N, 1 To 2) For i1 = 1 To N ReDim v(1 To 63) As Double Input #1, ID_SP, ID_SPc, MINUS, _ v(2), v(3), v(4), v(5), v(6), v(7), v(8), v(9), v(10), v(11), v(12), v(13), v(14), _ v(15), v(16), v(17), v(18), v(19), v(20), v(21), v(22), v(24), v(28), aux, aux, aux, _ aux, aux, aux, aux, aux, aux, aux, v(60), v(63), VNBIM, aux, aux, X(i1, 0) X(i1, 5) = 1 ' Factor elevació c(i1, 1) = ID_SP c(i1, 4) = VNBIM ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Actualitza béns i drets amb els coeficients de projecció' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 2 To 63 If j1 = 2 Or j1 = 63 Then v(j1) = v(j1) * PROJ(1) If j1 >= 8 And j1 <= 13 Then v(j1) = v(j1) * PROJ(2) If j1 >= 3 And j1 <= 7 Or j1 >= 14 And j1 <= 22 Then v(j1) = v(j1) * PROJ(3) Next j1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Variables d' interès ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1,0) = Patrimoni exempt + no exempt' ' X(i1,1) = Base Imposable ' ' X(i1,2) = Base Liquidable ' ' X(i1,3) = Quota per a ingressar ' ' X(i1,4) = Patrimoni exempt ' ' X(i1,5) = Factor elevació ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1,6) = 1 (guanyadors) ' ' X(i1,7) = X(i1,6)*guany ' ' X(i1,8) = 1 (perdedors) ' ' X(i1,9) = X(i1,8)*pèrdua ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina la BI descomptant els mímims exempts (cas particular per a v(1)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 1) = IIf(BENS_E(1) = 1, 0, Application.Max(0, v(60) - MINIMS_E(1)) + v(63)) For j1 = 2 To 22 If BENS_E(j1) = 0 Then If v(j1) > 0 Then X(i1, 1) = X(i1, 1) + Application.Max(0, v(j1) - MINIMS_E(j1)) If v(j1) < 0 Then X(i1, 1) = X(i1, 1) + v(j1) End If Next j1 X(i1, 1) = Application.Max(0, X(i1, 1) - v(24)) ' Descompta deutes deduïbles c(i1, 2) = X(i1, 1) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina el Patrimoni exempt (sumant bens exempts i minims exempts, cas particular per a v(1)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 4) = IIf(BENS_E(1) = 1, Application.Max(0, v(60) + v(63)), Application.Max(0, Application.Min(v(60), MINIMS_E(1)))) For j1 = 2 To 22 If v(j1) > 0 Then X(i1, 4) = X(i1, 4) + IIf(BENS_E(j1) = 1, v(j1), Application.Min(v(j1), MINIMS_E(j1))) Next j1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina la BL descomptant la reducció per obligació personal ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 2) = Application.Max(0, X(i1, 1) - REDUCCIO(1)) If v(28) <> 0 Then X(i1, 2) = X(i1, 2) + v(28) ' Recalcula BL pels especials (exempts) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina la Quota íntegra segons la tarifa i trams indicats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' X(i1, 3) = 0 If X(i1, 2) > 0 Then If NTRAMS = 1 Then X(i1, 3) = X(i1, 2) * TIPUS(1) Else it = NTRAMS If X(i1, 2) <= T(1) Then X(i1, 3) = X(i1, 2) * TIPUS(1) If NTRAMS > 2 Then For j1 = 2 To NTRAMS - 1 If X(i1, 2) > T(j1 - 1) And X(i1, 2) <= T(j1) Then X(i1, 3) = tt(j1 - 1) + ((X(i1, 2) - T(j1 - 1)) * TIPUS(j1)) Next j1 End If If X(i1, 2) > T(it - 1) Then X(i1, 3) = tt(it - 1) + ((X(i1, 2) - T(it - 1)) * TIPUS(it)) End If End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Recalcula la quota pels especials "exempts" ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If v(28) <> 0 Then X(i1, 3) = (X(i1, 2) - v(28)) * Round(X(i1, 3) / X(i1, 2), 4) X(i1, 2) = X(i1, 2) - v(28) ' Recalcula BL pels especials (exempts) End If c(i1, 3) = X(i1, 3) Next i1 Close #1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' 2a. Lectura de dades: càlculs posteriors a la quota íntegra amb connexió IRPF' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim i_pag As Integer, spes2, vgp, IRPF_CONJUNTA As String * 1, LIMIT_QUOTES As Integer, N_conjuntes As Long ReDim IND(1 To N, 2), MITJANA(1 To 5), PAG(1 To 3), SUMA(1 To 9), vpag(1 To 4), VT(1 To 28, 12), vx(1 To 4, 1 To 6) Open NOM_IPPF_DADES & ANOIPPF & ".dat" For Input As #1 Input #1, N, N_conjuntes NT = 0 spes2 = 0 For i1 = 1 To N Dim v25c As Double, v29c As Double, v36_1 As Double, v36_2 As Double, VNBIMc As Double ReDim v(1 To 63) As Double Input #1, ID_SP, ID_SPc, MINUS, _ aux, aux, aux, aux, aux, aux, aux, aux, aux, aux, aux, aux, aux, _ aux, aux, aux, aux, aux, aux, aux, aux, aux, aux, v(30), v(31), v(32), _ v(34), v(35), v(41), v(42), v(43), v(50), v(55), aux, aux, VNBIM, IRPF_CONJUNTA, LIMIT_QUOTES, aux i_pag = 0 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Connexió amb l' IRPF: determina els límits per obligació personal' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' v(29) = X(i1, 3) If X(i1, 3) > 0 And LIMIT_QUOTES <> 0 And CONNEXIO_IRPF Then If IRPF_CONJUNTA = "I" Then v(33) = LIMITS(1) * Application.Max(0, v(30) + v(31) - v(32)) v(36) = X(i1, 3) - VNBIM * X(i1, 3) / X(i1, 1) v(37) = v(34) - v(35) + v(36) If v(33) < v(37) Then v(38) = v(37) - v(33) v(39) = LIMITS(2) * X(i1, 3) X(i1, 3) = X(i1, 3) - Application.Min(v(38), v(39)) End If ElseIf IRPF_CONJUNTA = "C" Then For i2 = 1 To N_conjuntes If ID_SPc = c(i2, 1) Then v25c = c(i2, 2) v29c = c(i2, 3) VNBIMc = c(i2, 4) Exit For End If Next i2 v(33) = LIMITS(1) * Application.Max(0, v(30) + v(31) - v(32)) v36_1 = X(i1, 3) - VNBIM * X(i1, 3) / X(i1, 1) v36_2 = v29c - VNBIMc * v29c / v25c v(36) = v36_1 + v36_2 v(37) = v(34) - v(35) + v(36) If v(33) < v(37) Then v(38) = (v(37) - v(33)) * (v36_1 / v(36)) v(39) = LIMITS(2) * X(i1, 3) X(i1, 3) = X(i1, 3) - Application.Min(v(38), v(39)) End If End If End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' v(40) = X(i1, 3) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Descompta de la Quota: ' - deducció per impostos a l' estranger v(41) ' - bonificació per béns a Ceuta i Melilla v(44) ' - bonificació autonòmica v(50) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If X(i1, 1) > 0 And X(i1, 3) > 0 Then If v(43) > 0 Then v(44) = 0.75 * Application.Min(v(43), 0.75 * X(i1, 3)) X(i1, 3) = Application.Max(0, X(i1, 3) - (v(41) + v(44) + v(50))) End If 'Write #100, ID_SP, ID_SPc, X(i1, 1), X(i1, 2), X(i1, 3) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Càlcul pagadors' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If X(i1, 3) > 0 Then i_pag = 1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Càlcul de guanyadors-perdedors' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'No es calcula G-P perquè la base de dades de referència treballa amb una obligació per reducció personal diferent en alguns casos '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' If ANOIPPF = IPPF_ANYREF Then ' vgp = v(55) - X(i1, 3) ' X(i1, 6) = 0 ' X(i1, 8) = 0 ' If Abs(vgp) > 1 Then ' If vgp > 0 Then ' X(i1, 6) = 1 ' X(i1, 8) = 0 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Write #100, ID_SP, ID_SPc, X(i1, 0), X(i1, 1), X(i1, 2), v25c, X(i1, 3), v(55), vgp, _ ' v(29), v29c, v(30), v(31), v(32), v(33), v(34), v(35), v(36), v(37), v(38), _ ' v(39), v(40), v(41), v(42), v(43), v(44), v(50), v(60), v(63), VNBIM, VNBIMc ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Else ' X(i1, 6) = 0 ' X(i1, 8) = 1 ' End If ' X(i1, 7) = vgp * X(i1, 6) ' X(i1, 9) = vgp * X(i1, 8) ' End If ' End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina les variables per al càlcul descriptiu' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To 4 If X(i1, j1) <> 0 Then vx(j1, 1) = vx(j1, 1) + (X(i1, j1) * X(i1, 5)) vx(j1, 2) = vx(j1, 2) + (X(i1, j1) * X(i1, 5) * X(i1, 5)) vx(j1, 3) = vx(j1, 3) + (X(i1, j1) * X(i1, j1) * X(i1, 5) * X(i1, 5)) vx(j1, 4) = vx(j1, 4) + 1 vx(j1, 5) = vx(j1, 5) + X(i1, 5) vx(j1, 6) = vx(j1, 6) + (X(i1, 5) * X(i1, 5)) End If Next j1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Determina les variables per al càlcul dels "no-pagadors"' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' spes2 = spes2 + (X(i1, 5) * X(i1, 5)) vpag(1) = vpag(1) + (i_pag * X(i1, 5)) vpag(2) = vpag(2) + (i_pag * X(i1, 5) * X(i1, 5)) vpag(3) = vpag(3) + (i_pag * X(i1, 5) * X(i1, 5)) NT = NT + X(i1, 5) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Grava els indicadors per guardar-los als arxius de comparació ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' SP(i1, 1) = ID_SP SP(i1, 2) = ID_SPc Next i1 Close #1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' AIXÒ ÉS PER A FER COMPROVACIONS ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Close #100 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To 4 SUMA(j1) = vx(j1, 1) MITJANA(j1) = SUMA(j1) / NT Next j1 MITJANA(5) = NT / N ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda(Descriptiu) a VT)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' VT(1, 0) = "Descriptiu" For j1 = 1 To 4 If vx(j1, 4) <> 0 Then VT(j1, 1) = (vx(j1, 1) / vx(j1, 5)) / 1000 VT(j1, 2) = (Sqr(vx(j1, 3) - (2 * VT(j1, 1) * vx(j1, 2)) + ((VT(j1, 1) ^ 2) * vx(j1, 6))) / vx(j1, 5)) / 1000 VT(j1, 3) = VT(j1, 1) - 1.96 * VT(j1, 2) VT(j1, 4) = VT(j1, 1) + 1.96 * VT(j1, 2) VT(j1, 5) = vx(j1, 1) / 1000000 VT(j1, 6) = Sqr(vx(j1, 3) - ((vx(j1, 1) ^ 2) / vx(j1, 4))) / 1000000 VT(j1, 7) = VT(j1, 5) - 1.96 * VT(j1, 6) VT(j1, 8) = VT(j1, 5) + 1.96 * VT(j1, 6) End If Next j1 PAG(1) = vpag(1) / NT vpag(4) = (Sqr(vpag(3) - (2 * PAG(1) * vpag(2)) + ((PAG(1) ^ 2) * spes2)) / NT) PAG(2) = PAG(1) - 1.95996 * vpag(4) PAG(3) = PAG(1) + 1.95996 * vpag(4) Call COMUNS_2ORDENA("IPPF") Call IPPF_22DECILS_INDEXS_GP(5, UBound(X, 2)) End Sub Private Sub IPPF_22DECILS_INDEXS_GP(pes, p2) ' pes=posicio pes (9) ' UBound(X, 2)=nombre variables Dim axx_b, axx_p, i1 As Long, it As Integer, j1 As Integer ReDim p(1 To 12, 2), xx_b(1 To N, 1 To 2), xx_p(1 To N) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula: xx_b(1 to N, 1 to 2)=(BI,BL*factor) acumulades / s(variables*factor) ' Calcula: xx_p(1 to N) =població acumulada/NT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For it = 1 To 2 For j1 = 1 To 2 If SUMA(j1) <> 0 Then axx_b = 0 For i1 = 1 To N axx_b = axx_b + (X(IND(i1, it), j1) * X(IND(i1, it), pes)) xx_b(i1, j1) = axx_b / SUMA(j1) ' BIT,BLT Next i1 End If Next j1 axx_p = 0 For i1 = 1 To N axx_p = axx_p + X(IND(i1, it), pes) xx_p(i1) = axx_p / NT ' pes Next i1 If it = 1 Then Call IPPF_23DECILS(p, pes, xx_b, xx_p) ' DECILS Call IPPF_24INDEXS(it, pes, xx_b, xx_p) ' INDEXS Next it 'If ANOIPPF = IPPF_ANYREF Then Call IPPF_25GP(p, pes) ' G-P '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'No es calcula G-P perquè la base de dades de referència treballa amb una obligació per reducció personal diferent en alguns casos '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' End Sub Private Sub IPPF_23DECILS(p, pes, xx_b, xx_p) Dim axx_r, i1 As Long, i2 As Long, j1 As Integer, k1 As Integer, l1 As Long ReDim ds(8, 12), ts(2, 12), xx_r(1 To N, 1 To pes - 3) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula: xx_r(1 to N, 1 to pes-3)=(resta * factor) acumulades / s(variables * factor) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To pes - 3 If SUMA(j1 + 2) <> 0 Then axx_r = 0 For i1 = 1 To N axx_r = axx_r + (X(IND(i1, 1), j1 + 2) * X(IND(i1, 1), pes)) xx_r(i1, j1) = axx_r / SUMA(j1 + 2) ' resta variables Next i1 End If Next j1 For k1 = 1 To 12 p(k1, 1) = IIf(k1 < 10, k1 / 10, IIf(k1 = 10, 0.95, IIf(k1 = 11, 0.98, 1))) p(k1, 2) = IIf(k1 < 10, 0.1, IIf(k1 = 10, 0.05, IIf(k1 = 11, 0.03, 0.02))) Next k1 i2 = 1 For k1 = 1 To 11 For i1 = i2 To N If xx_p(i1) >= p(k1, 1) Then p(k1, 0) = i1 ' p(1 to 12, 0 = Observació on comença cada decil i2 = i1 Exit For End If Next i1 Next k1 p(12, 0) = N ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Càlcul DECILS (1a dimensió parell decil acumulat) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' VT(7 ,1 to 12)=Base imposable (1)=ds(1, 1 to 12)' ' VT(9 ,1 to 12)=Base liquidable (2)=ds(3, 1 to 12)' ' VT(11,1 to 12)=Quota (3)=ds(5, 1 to 12)' ' VT(13,1 to 12)=Patrimoni exempt (4)=ds(7, 1 to 12)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For k1 = 1 To 12 l1 = p(k1, 0) For j1 = 1 To 2 ds(2 * j1, k1) = xx_b(l1, j1) ' BIT, BLT If k1 = 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) If k1 > 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) - ds(2 * j1, k1 - 1) Next j1 For j1 = 3 To pes - 1 ds(2 * j1, k1) = xx_r(l1, j1 - 2) ' resta If k1 = 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) If k1 > 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) - ds(2 * j1, k1 - 1) Next j1 Next k1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Càlcul tipus efectius ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' VT(15,1 to 12)= QPI s/BI (3/1)=ts( 1, 1 to 12)' ' VT(16,1 to 12)= QPI s/BL (3/2)=ts( 2, 1 to 12)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For k1 = 1 To 12 If SUMA(1) <> 0 And ds(1, k1) <> 0 Then ts(1, k1) = (ds(5, k1) * SUMA(3)) / (ds(1, k1) * SUMA(1)) End If If SUMA(2) <> 0 And ds(3, k1) <> 0 Then ts(2, k1) = (ds(5, k1) * SUMA(3)) / (ds(3, k1) * SUMA(2)) End If Next k1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda límits i mitjanes, decils i tipus a VT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' VT(5, 0) = "Límits i mitjanes " VT(7, 0) = "Decils" VT(15, 0) = "Tipus" For k1 = 1 To 12 VT(5, k1) = (X(IND(p(k1, 0), 1), 1)) / 1000 VT(6, k1) = (ds(1, k1) * SUMA(1) / (NT * IIf(k1 < 10, 0.1, IIf(k1 = 10, 0.05, IIf(k1 = 11, 0.03, 0.02))))) / 1000 For j1 = 1 To 8 VT(6 + j1, k1) = ds(j1, k1) Next j1 For j1 = 1 To 2 VT(14 + j1, k1) = ts(j1, k1) Next j1 Next k1 End Sub Private Sub IPPF_24INDEXS(it, pes, xx_b, xx_p) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' INDEXS 55 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Gini: g 2 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Concentració: c 2 ' Kakwani: k 2 ' Suits: s 2 ' Efecte Redistributiu: e 2 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Dim aconc, aefre, agini, asuit, daux(1 To 4), _ i1 As Long, j1 As Integer, k1 As Integer, l1 As Integer, sxx_b As Double Dim g, c, k, s, e As Double agini = 0 sxx_b = 0 If SUMA(it) <> 0 Then For i1 = 1 To N daux(1) = X(IND(i1, it), it) - MITJANA(it) daux(2) = xx_p(i1) - MITJANA(pes) daux(3) = X(IND(i1, it), pes) agini = agini + (daux(1) * daux(2) * daux(3)) sxx_b = sxx_b + xx_b(i1, it) ' s.acum. BII,BIT,BLT Next i1 If agini <> 0 Then g = 2 / MITJANA(it) * (agini / NT) ' gini End If aconc = 0 aefre = 0 asuit = 0 If SUMA(j1 + 2) <> 0 Then For i1 = 1 To N daux(1) = X(IND(i1, it), 3) - MITJANA(3) daux(2) = xx_p(i1) - MITJANA(pes) daux(3) = X(IND(i1, it), pes) daux(4) = xx_b(i1, it) - (sxx_b / N) aconc = aconc + (daux(1) * daux(2) * daux(3)) asuit = asuit + (daux(1) * daux(4) * daux(3)) Next i1 If aconc <> 0 Then c = 2 / MITJANA(3) * (aconc / NT) ' concentració k = c - g ' kakwani s = (2 * (asuit / NT) / MITJANA(3)) - g ' suits If SUMA(it) <> 0 Then aefre = SUMA(3) / SUMA(it) e = (aefre / (1 - aefre)) * k ' ef red. End If ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda els resultats(Índexs) a VT' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' If it = 1 Then VT(17, 0) = "Índexs" VT(16 + it, it) = g VT(19, it) = c VT(20, it) = k VT(21, it) = s VT(22, it) = e End Sub Private Sub IPPF_25GP(p, pes) Dim axx_gp(1 To 4), i1 As Long, j1 As Integer, k1 As Integer ReDim GP(1 To 6, 1 To 12), xx_gp(1 To N, 1 To 4), y(4, 12) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula: xx_gp(1 to N, pes + 1 to pes + 4) = (GP * factor) acumulades ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To 4 ' If SUMA(j1) <> 0 Then axx_gp(j1) = 0 For i1 = 1 To N axx_gp(j1) = axx_gp(j1) + (X(IND(i1, 0), j1 + pes) * X(IND(i1, 0), pes)) xx_gp(i1, j1) = axx_gp(j1) Next i1 ' End If Next j1 For k1 = 1 To 12 i1 = p(k1, 0) For j1 = 1 To 4 y(j1, k1) = xx_gp(i1, j1) Next j1 Next k1 For k1 = 1 To 12 GP(1, k1) = y(1, k1) - y(1, k1 - 1) GP(2, k1) = y(2, k1) - y(2, k1 - 1) If GP(1, k1) <> 0 Then GP(3, k1) = GP(2, k1) / Round(GP(1, k1), 0) 'guanys per capita GP(4, k1) = y(3, k1) - y(3, k1 - 1) GP(5, k1) = y(4, k1) - y(4, k1 - 1) If GP(4, k1) <> 0 Then GP(6, k1) = GP(5, k1) / Round(GP(4, k1), 0) 'pèrdues per capita GP(1, k1) = GP(1, k1) / (p(k1, 2) * NT) '%guanyadors GP(2, k1) = GP(2, k1) / 1000 'guanys GP(4, k1) = GP(4, k1) / (p(k1, 2) * NT) '%perdedors GP(5, k1) = GP(5, k1) / 1000 'pèrdues Next k1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Guarda(Guanyadors) a VT) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' VT(23, 0) = "Guanyadors" For k1 = 1 To 12 For j1 = 1 To 6 VT(22 + j1, k1) = IIf(j1 = 4, -1, 1) * GP(j1, k1) Next j1 Next k1 End Sub Private Sub IPPF_30COMPARACIO(opcio As Integer) Dim aux, i1 As Long, it As Integer, j1 As Integer, k1 As Integer, ds(), GP() ReDim a(1 To 7) Open NOM_IPPF_SIMUL & "GP" & ANOIPPF & "_" & Trim(Str(COMP(1))) & ".dat" For Input As #1 Open NOM_IPPF_SIMUL & "GP" & ANOIPPF & "_" & Trim(Str(COMP(2))) & ".dat" For Input As #2 Input #1, N Input #1, a(1), a(2), a(3), a(4), a(5), a(6), a(7) 'Segona línia de noms Input #2, N Input #2, a(1), a(2), a(3), a(4), a(5), a(6), a(7) 'Segona línia de noms ReDim X(1 To N, 1 To 7), IND(i1 To N, 1 To 2) For i1 = 1 To N Input #1, a(1), a(2), a(3), a(4), X(i1, 1), IND(i1, 1), IND(i1, 2) Input #2, a(1), a(2), a(3), a(4), X(i1, 2), a(5), a(6) Next i1 Close #1 Close #2 For it = 1 To 2 ' it=1 ordre PE+PNE it=2 ordre BI ReDim s(1 To 7) As Double For i1 = 1 To N aux = X(IND(i1, it), 1) - X(IND(i1, it), 2) X(IND(i1, it), 3) = 0 X(IND(i1, it), 5) = 0 If Abs(aux) > 1 Then If aux > 0 Then X(IND(i1, it), 3) = 1 X(IND(i1, it), 5) = 0 Else X(IND(i1, it), 3) = 0 X(IND(i1, it), 5) = 1 End If X(IND(i1, it), 4) = aux * X(IND(i1, it), 3) X(IND(i1, it), 6) = aux * X(IND(i1, it), 5) End If For j1 = 1 To 6 s(j1) = s(j1) + X(IND(i1, it), j1) Next j1 s(7) = s(7) + 1 Next i1 Call IPPF_31COMPARACIO_DECILS_GP(it, ds, GP, s) Call IPPF_32COMPARACIO_ESCRIPTURA(it, ds, GP, s) Next it Call COMUNS_5IMPRESSIO("IPPF", "G-P") End Sub Private Sub IPPF_31COMPARACIO_DECILS_GP(it, ds, GP, s) Dim aux, i1 As Long, i2 As Long, j1 As Integer, k1 As Integer, l1 As Long ReDim p(1 To 12, 2), ds(1 To 4, 1 To 12), GP(1 To 8, 1 To 12), xx(1 To N, 1 To 7), y(4, 12) As Double ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Calcula xx(1 to N, 1 to 6)=(variables * factor) acumulades / s(variables * factor) ' xx(1 to N, 7) = població acumulada/s(7) s(7)=NT ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For j1 = 1 To 6 aux = 0 If s(j1) <> 0 Then For i1 = 1 To N aux = aux + X(IND(i1, it), j1) xx(i1, j1) = aux / IIf(j1 <= 2, s(j1), 1) Next i1 End If Next j1 aux = 0 For i1 = 1 To N aux = aux + 1 xx(i1, 7) = aux / s(7) Next i1 For j1 = 1 To 12 p(j1, 1) = IIf(j1 < 10, j1 / 10, IIf(j1 = 10, 0.95, IIf(j1 = 11, 0.98, 1))) p(j1, 2) = IIf(j1 < 10, 0.1, IIf(j1 = 10, 0.05, IIf(j1 = 11, 0.03, 0.02))) Next j1 i2 = 1 For j1 = 1 To 11 For i1 = i2 To N If xx(i1, 7) >= p(j1, 1) Then p(j1, 0) = i1 ' p(1 to 12, 0 = Observació on comença cada decil i2 = i1 Exit For End If Next i1 Next j1 p(12, 0) = N ' ' ' ' ' ' ' ' ' DECILS' ' ' ' ' ' ' ' For k1 = 1 To 12 l1 = p(k1, 0) For j1 = 1 To 2 ds(2 * j1, k1) = xx(l1, j1) If k1 = 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) If k1 > 1 Then ds(2 * j1 - 1, k1) = ds(2 * j1, k1) - ds(2 * j1, k1 - 1) Next j1 Next k1 ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' GUANYADORS-PERDEDORS' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' For k1 = 1 To 12 l1 = p(k1, 0) For j1 = 1 To 4 y(j1, k1) = xx(l1, j1 + 2) Next j1 Next k1 For k1 = 1 To 12 For j1 = 1 To 8 GP(j1, k1) = 0 Next j1 GP(1, k1) = (y(1, k1) - y(1, k1 - 1)) / (p(k1, 2) * s(7)) '%guanyadors GP(2, k1) = Round(y(1, k1) - y(1, k1 - 1), 0) 'guanyadors totals GP(3, k1) = (y(2, k1) - y(2, k1 - 1)) / 1000 'guanys totals If GP(2, k1) <> 0 Then GP(4, k1) = GP(3, k1) * 1000 / GP(2, k1) 'guanys per capita GP(5, k1) = (y(3, k1) - y(3, k1 - 1)) / (p(k1, 2) * s(7)) '%perdedors GP(6, k1) = Round(y(3, k1) - y(3, k1 - 1), 0) 'perdedors totals GP(7, k1) = (y(4, k1) - y(4, k1 - 1)) / 1000 'pèrdues totals If GP(6, k1) <> 0 Then GP(8, k1) = GP(7, k1) * 1000 / GP(6, k1) 'pèrdues per capita Next k1 For k1 = 1 To 12 GP(5, k1) = -GP(5, k1) 'Pel gràfic Next k1 End Sub Private Sub IPPF_32COMPARACIO_ESCRIPTURA(it, ds, GP, s) Dim avisgp As Boolean, nom As String, fila As Integer, i1 As Integer, llibre As Integer, nota As String, r_f(1 To 2, 1 To 3) As Range ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1 to 2, 1)==> formats del llibre "FORMATS", full "IPPF" ' ' r_f(1 to 2, 2)==> formats del llibre "SIMCAN", full "(G-P)" ' ' r_f(1 to 2, 3)==> formats del llibre "SIMCAN", full "(G-P)" (només valors)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Application.ScreenUpdating = False nom = ThisWorkbook.Path & "\DADES\Formats.XLSX" Set LLIBRE_FORMATS = Workbooks.Open(nom) llibre = Workbooks.Count Workbooks(llibre).Activate ' llibre "FORMATS" Sheets("IPPF").Activate Set r_f(1, 1) = Range(Cells(136, 1), Cells(144, 15)) ' Decils Set r_f(2, 1) = Range(Cells(146, 1), Cells(155, 15)) ' Guanyadors ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Crea el full de càlcul on escriu els resultats definitius' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' fila = (it - 1) * 67 + 1 ThisWorkbook.Activate ' llibre "SIMCAN" If it = 1 Then Call COMUNS_0NOMSFULLS("IPPF(G-P)") ActiveWorkbook.Unprotect (SECRET) End If Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate Sheets("IPPF(G-P)").Activate ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Configura el rang d' escriptura' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' With Range(Cells(fila, 1), Cells(fila + 66, 15)) .ColumnWidth = 6.43 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 11 End With With Range(Cells(fila, 1), Cells(fila + 1, 1)) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 End With Cells(fila, 1).Value = "IMPOST DEL PATRIMONI DE LES PERSONES FÍSIQUES" Cells(fila + 1, 1).Value = "COMPARACIÓ SIMULACIÓ-" & COMP(1) & " vs. SIMULACIÓ-" & COMP(2) & " (Base de dades: " & ANOIPPF & ")" Set r_f(1, 2) = Range(Cells(fila + 2, 1), Cells(fila + 10, 15)) ' Decils Rangs d' escriptura Set r_f(2, 2) = Range(Cells(fila + 12, 1), Cells(fila + 21, 15)) ' Guanyadors Rangs d' escriptura Set r_f(1, 3) = Range(Cells(fila + 5, 4), Cells(fila + 8, 15)) ' Decils Rangs de valors Set r_f(2, 3) = Range(Cells(fila + 14, 4), Cells(fila + 21, 15)) ' Guanyadors Rangs de valors ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriu els resultats numèrics' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1, 1).Copy Destination:=r_f(1, 2) r_f(1, 2).Rows(1).Columns(1).Value = Cells(fila + 2, 1) & IIf(it = 1, " Patrimoni exempt + no exempt)", " Base imposable)") r_f(1, 2).Rows(4).Columns(1).Value = "Quota SIMULACIÓ-" & COMP(1) r_f(1, 2).Rows(6).Columns(1).Value = "Quota SIMULACIÓ-" & COMP(2) r_f(1, 2).Rows(8).Columns(1).Value = "SIMULACIÓ-" & COMP(1) r_f(1, 2).Rows(9).Columns(1).Value = "SIMULACIÓ-" & COMP(2) r_f(1, 2).Rows(8).Columns(3).Value = s(1) / 1000000 r_f(1, 2).Rows(9).Columns(3).Value = s(2) / 1000000 r_f(1, 2).Rows(9).Columns(6).Value = s(3) r_f(1, 2).Rows(9).Columns(8).Value = s(5) If s(1) = s(2) Then nota = "Simulacions neutrals" ElseIf s(1) > s(2) Then nota = "Pèrdua en recaptació" Else nota = "Guany en recaptació" End If r_f(1, 2).Rows(8).Columns(11).Value = nota If nota <> "Simulacions neutrals" Then r_f(1, 2).Rows(9).Columns(11).Value = (s(2) - s(1)) / 1000000 Else With Range(Cells(fila + 9, 11), Cells(fila + 10, 13)) .Interior.Pattern = xlCrissCross .MergeCells = True .Value = nota End With End If r_f(1, 2).Rows(9).Columns(15).Value = s(7) r_f(2, 1).Copy Destination:=r_f(2, 2) r_f(2, 2).Rows(1).Columns(1).Value = Cells(fila + 12, 1) & IIf(it = 1, " Patrimoni exempt + no exempt)", " Base imposable)") r_f(1, 3).Value = ds r_f(2, 3).Value = GP r_f(2, 3).ShrinkToFit = True LLIBRE_FORMATS.Close ' ' ' ' ' ' ' ' ' ' ' ' ' ' Gràfics G-P' ' ' ' ' ' ' ' ' ' ' ' ' ' For i1 = 1 To 12 If Abs(r_f(2, 3).Rows(1).Columns(i1)) > 0.001 Or Abs(r_f(2, 3).Rows(5).Columns(i1)) > 0.001 Then avisgp = True Exit For End If Next i1 If avisgp Then Dim r_gp(1 To 2, 1 To 4) As Range Set r_gp(1, 1) = r_f(1, 3).Rows(1) ' Quota Simulació-1' Set r_gp(2, 1) = r_f(1, 3).Rows(3) ' Quota Simulació-2' Set r_gp(1, 2) = r_f(2, 3).Rows(1) ' % guanyadors' Set r_gp(2, 2) = r_f(2, 3).Rows(5) ' % perdedors' Set r_gp(1, 3) = r_f(2, 3).Rows(3) ' Total guanys' Set r_gp(2, 3) = r_f(2, 3).Rows(7) ' Total pèrdues' Set r_gp(1, 4) = r_f(2, 3).Rows(4) ' guanyadors per capita' Set r_gp(2, 4) = r_f(2, 3).Rows(8) ' perdedors per capita' r_gp(2, 2).NumberFormat = "0.00%;[Red]0.00%" Call COMUNS_43GRAFICS_GP(23 + fila, ANOIPPF, "IPPF", "(G-P)", r_gp, 1) For i1 = 1 To Worksheets("IPPF(G-P)").Shapes.Count Worksheets("IPPF(G-P)").Shapes(i1).Left = IIf(i1 = 1 Or i1 = 3 Or i1 = 5 Or i1 = 7, 10, 280) ' Reposicionament imatges Next i1 End If ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 67, 1)) If it > 1 Then ActiveSheet.Protect (SECRET) End Sub Private Sub IPPF_40ESCRIPTURA(opcio As Integer) Dim avisgp As Boolean, fila As Integer, GP As Boolean, i As Integer, i1 As Integer, j1 As Integer, _ llibre(1 To 2) As Integer, nom As String, _ r_ref(1 To 3) As Range, r_f(1 To 5, 1 To 4) As Range, r_parms(1 To 2) As Range, _ r_gp(1 To 2, 1 To 4) As Range ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' r_f(1 to 6, 1)==> formats del llibre "FORMATS", full "IPPF" ' ' r_f(1 to 6, 2)==> formats del llibre "RESULTATS" temporals ' ' r_f(1 to 6, 3)==> formats del llibre "SIMCAN", full "IPPF(R)" ' ' r_f(1 to 6, 3)==> formats del llibre "SIMCAN", full "IPPF(R)" (només valors)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Application.ScreenUpdating = False nom = ThisWorkbook.Path & "\DADES\Formats.XLSX" Set LLIBRE_FORMATS = Workbooks.Open(nom) llibre(1) = Workbooks.Count Workbooks(llibre(1)).Activate ' llibre "FORMATS" Sheets("IPPF").Activate Set r_parms(1) = Range(Cells(2, 1), Cells(27, 9)) ' Paràmetres Set r_f(1, 1) = Range(Cells(29, 1), Cells(38, 11)) ' Descriptiu Set r_f(2, 1) = Range(Cells(40, 1), Cells(43, 13)) ' Límits i mitjana per decils Set r_f(3, 1) = Range(Cells(45, 1), Cells(57, 15)) ' Decils Set r_f(4, 1) = Range(Cells(59, 1), Cells(67, 6)) ' Índexs Set r_f(5, 1) = Range(Cells(69, 1), Cells(76, 15)) ' Guanyadors Set r_ref(1) = Range(Cells(78, 1), Cells(134, 15)) ' Referència ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Crea el full de càlcul on escriu els resultats definitius ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" Call COMUNS_0NOMSFULLS("IPPF(R)") ActiveWorkbook.Unprotect (SECRET) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriu els resultats de la referència' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' fila = 59 Sheets("SIMULADOR REFORMAS IMPOSITIVAS").Activate Sheets("IPPF(R)").Activate Set r_ref(2) = Range(Cells(1, 1), Cells(fila - 2, 15)) With r_ref(2) .ColumnWidth = 6.43 .RowHeight = 11 End With r_ref(2).Rows(2).RowHeight = 14 r_ref(2).Rows(29).RowHeight = 12 r_ref(2).Rows(43).RowHeight = 12 r_ref(2).Rows(48).RowHeight = 12 r_ref(1).Copy Destination:=r_ref(2) ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila - 1, 1)) For i1 = 1 To UBound(IRESULTS) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Lectura en els arxius temporals de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' nom = NOM_IPPF_SIMUL & "S" & ANOIPPF & "_" & Trim(Str(IRESULTS(i1))) & ".xlsx" Set LLIBRE_RESULTATS = Workbooks.Open(nom) llibre(2) = Workbooks.Count Workbooks(llibre(2)).Activate ' llibre "RESULTATS" Sheets("PARAMETRES").Activate ' Paràmetres ReDim p(37, 8) For i = 0 To 37 For j1 = 1 To 7 p(i, j1) = Cells(i + 1, j1) Next j1 Next i Sheets("DESCRIPTIU").Activate ' Descriptiu Set r_f(1, 2) = Range(Cells(1, 1), Cells(4, 8)) Sheets("LIMITS-MITJANES").Activate ' Límits i mitjanes Set r_f(2, 2) = Range(Cells(1, 1), Cells(2, 12)) Sheets("DECILS-TIPUS").Activate ' Decils BI i Tipus efectius QT s/BI QT s/BL Set r_f(3, 2) = Range(Cells(1, 1), Cells(10, 12)) Sheets("INDEXS").Activate ' Indexs Set r_f(4, 2) = Range(Cells(1, 1), Cells(6, 2)) Sheets("G-P").Activate ' Guanyadors-Perdedors Set r_f(5, 2) = Range(Cells(1, 1), Cells(6, 12)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriptura en el full definitiu de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ThisWorkbook.Activate ' llibre "SIMCAN" With Range(Cells(fila - 1, 1), Cells(fila + 74, 15)) .ColumnWidth = 6.43 .HorizontalAlignment = xlCenter .Interior.ColorIndex = 2 .RowHeight = 11 End With With Range(Cells(fila - 1, 1), Cells(fila - 1, 1)) With .Font .Bold = True .Size = 10 End With .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "SIMULACIÓ-" & IRESULTS(i1) & " (Base de dades: " & ANOIPPF & ")" End With Call IPPF_41ESCRIPTURA_PARAMETRES(fila, p, r_parms) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Rangs per a l' escriptura en el llibre SIMCAT full IPPF(R)' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Set r_f(1, 3) = Range(Cells(fila + 27, 1), Cells(fila + 36, 11)) ' Descriptiu Set r_f(1, 4) = Range(Cells(fila + 31, 4), Cells(fila + 34, 11)) Set r_f(2, 3) = Range(Cells(fila + 38, 1), Cells(fila + 41, 13)) ' Límits i mitjanes per decils Set r_f(2, 4) = Range(Cells(fila + 40, 2), Cells(fila + 41, 13)) Set r_f(3, 3) = Range(Cells(fila + 43, 1), Cells(fila + 55, 15)) ' Decils Set r_f(3, 4) = Range(Cells(fila + 46, 4), Cells(fila + 55, 15)) Set r_f(4, 3) = Range(Cells(fila + 57, 1), Cells(fila + 66, 6)) ' Índexs Set r_f(4, 4) = Range(Cells(fila + 60, 5), Cells(fila + 66, 6)) Set r_f(5, 3) = Range(Cells(fila + 67, 1), Cells(fila + 75, 15)) ' Guanyadors Set r_f(5, 4) = Range(Cells(fila + 69, 4), Cells(fila + 75, 15)) For j1 = 1 To 4 r_f(j1, 1).Copy Destination:=r_f(j1, 3) r_f(j1, 2).Copy: r_f(j1, 4).PasteSpecial xlPasteValues If j1 = 1 Then r_f(j1, 3).Rows(10).Columns(6).Value = p(0, 5) r_f(j1, 3).Rows(10).Columns(7).Value = p(0, 6) r_f(j1, 3).Rows(10).Columns(8).Value = p(0, 7) r_f(j1, 3).Rows(10).Columns(10).Value = p(0, 4) End If Next j1 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'No es calcula G-P perquè la base de dades de referència treballa amb una obligació per reducció personal diferent en alguns casos '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' GP = False ' If p(0, 1) = ANOIPPF Then GP = True Else GP = False ' If GP Then ' r_f(5, 1).Copy Destination:=r_f(5, 3) ' r_f(5, 2).Copy: r_f(5, 4).PasteSpecial xlPasteValues ' r_f(5, 4).ShrinkToFit = True ' End If LLIBRE_RESULTATS.Close ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 75, 1)) ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Rangs dels gràfics ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Set r_ref(3) = Range(Cells(48, 4), Cells(fila - 2, 15)) ReDim r_g(1 To IIf(GP, 7, 3), 1 To 4) As Range Set r_g(1, 1) = r_f(3, 4).Rows(2) ' BI acum. (sim) Set r_g(2, 1) = r_f(3, 4).Rows(6) ' QPI acum. (sim) Set r_g(3, 1) = r_f(3, 4).Rows(6) ' QPI acum. (sim) Set r_g(1, 2) = r_f(3, 4).Rows(4) ' BL acum. (sim) Set r_g(2, 2) = r_f(3, 4).Rows(6) ' QPI acum. (sim) Set r_g(3, 2) = r_f(3, 4).Rows(6) ' QPI acum. (sim) If GP Then Set r_g(5, 1) = r_ref(3).Rows(2) ' BI acum. (ref) Set r_g(6, 1) = r_ref(3).Rows(6) ' QPI acum. (ref) Set r_g(7, 1) = r_ref(3).Rows(6) ' QPI acum. (ref) Set r_g(5, 2) = r_ref(3).Rows(4) ' BL acum. (ref) Set r_g(6, 2) = r_ref(3).Rows(6) ' QPI acum. (ref) Set r_g(7, 2) = r_ref(3).Rows(6) ' QPI acum. (ref) End If Set r_g(1, 3) = r_f(3, 4).Rows(9) ' QPI s/BI (sim) Set r_g(1, 4) = r_f(3, 4).Rows(10) ' QPI s/BL (sim) If GP Then Set r_g(2, 3) = r_ref(3).Rows(9) ' QPI s/BI (ref) Set r_g(2, 4) = r_ref(3).Rows(10) ' QPI s/BL (ref) End If If GP Then Set r_gp(1, 1) = r_f(3, 4).Rows(5) ' QPI (sim) Set r_gp(2, 1) = r_ref(3).Rows(5) ' QPI (ref) ' ull Set r_gp(1, 2) = r_f(5, 4).Rows(1) ' % guanyadors' Set r_gp(2, 2) = r_f(5, 4).Rows(4) ' % perdedors' Set r_gp(1, 3) = r_f(5, 4).Rows(2) ' Total guanys' Set r_gp(2, 3) = r_f(5, 4).Rows(5) ' Total pèrdues' Set r_gp(1, 4) = r_f(5, 4).Rows(3) ' Mitjana guanyadors' Set r_gp(2, 4) = r_f(5, 4).Rows(6) ' Mitjana perdedors' r_gp(2, 2).NumberFormat = "0.00%;[Red]0.00%" End If If GP Then avisgp = False For j1 = 1 To 12 If Abs(r_gp(1, 2).Columns(j1)) > 0.001 Or Abs(r_gp(2, 2).Columns(j1)) > 0.001 Then avisgp = True Exit For End If Next j1 End If Call IPPF_42ESCRIPTURA_GRAFICS(fila + 76, GP, avisgp, r_g, r_gp, IRESULTS(i1)) fila = fila + 123 + IIf(avisgp, 47, 0) Next i1 LLIBRE_FORMATS.Close Call COMUNS_5IMPRESSIO("IPPF", "R") End Sub Private Sub IPPF_41ESCRIPTURA_PARAMETRES(fila, p, r_parms) Dim i1 As Integer, j1 As Integer Set r_parms(2) = Range(Cells(fila, 1), Cells(fila + 25, 9)) ' Paràmetres r_parms(1).Copy Destination:=r_parms(2) With r_parms(2) .Font.Size = 8 For i1 = 1 To 22 ' bens exempts i mínims exempts .Rows(4 + i1).Columns(2).Value = IIf(p(i1, 1) = "x", "EXEMPT", "") .Rows(4 + i1).Columns(3).Value = IIf(p(i1, 2) <> 0, p(i1, 2), "") Next i1 For i1 = 1 To p(0, 2) ' tarifa .Rows(4 + i1).Columns(4).Value = p(23 + i1, 1) .Rows(4 + i1).Columns(6).Value = p(23 + i1, 2) .Rows(4 + i1).Columns(8).Value = p(23 + i1, 3) Next i1 If p(0, 2) <> 12 Then With Range(Cells(fila + p(0, 2) + 4, 4), Cells(fila + 15, 8)) .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "" End With With Range(Cells(fila + p(0, 2) + 4, 4), Cells(fila + p(0, 2) + 4, 8)) With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium End With End With End If If p(0, 2) <> 12 Then For i1 = p(0, 2) To 12 Cells(fila + 4 + i1, 8).Borders(xlEdgeRight).LineStyle = xlNone Next i1 End If .Rows(18).Columns(7) = p(23, 1) ' reducció general .Rows(19).Columns(7) = p(23, 2) ' reducció discapacitats If p(0, 3) Then .Rows(21).Columns(8).Value = p(36, 1) ' BI IRPF .Rows(22).Columns(8).Value = p(36, 2) ' QI IPPF Else With Range(Cells(fila + 19, 4), Cells(fila + 21, 8)) .Font.Bold = True .HorizontalAlignment = xlCenter .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "SENSE CONNEXIÓ IRPF" End With End If If p(37, 1) <> 1 Or p(37, 2) <> 1 Or p(37, 3) <> 1 Then .Rows(24).Columns(8).Value = p(37, 1) ' Projecció immobles .Rows(25).Columns(8).Value = p(37, 2) ' Projecció cotitzacions .Rows(26).Columns(8).Value = p(37, 3) ' Projecció resta de béns Else With Range(Cells(fila + 22, 4), Cells(fila + 25, 8)) .Font.Bold = True .HorizontalAlignment = xlCenter .Interior.Pattern = xlCrissCross .MergeCells = True .Value = "SENSE PROJECCIONS" End With End If End With End Sub Private Sub IPPF_42ESCRIPTURA_GRAFICS(fila, GP, avisgp, r_g, r_gp, sim) Dim i1 As Integer, i2 As Integer, j1 As Integer, mmax As Double, nom() As String, s_r() As Boolean ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' Escriptura en el full definitiu de resultats' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' With Range(Cells(fila - 1, 1), Cells(fila + 45 + IIf(avisgp, 46, 0), 15)) .ColumnWidth = 6.43 .Interior.ColorIndex = 2 .RowHeight = 10 End With With Range(Cells(fila - 1, 1), Cells(fila - 1, 1)) .Font.Bold = True .Font.Size = 10 .HorizontalAlignment = xlLeft .RowHeight = 14 .Value = "GRÀFICS DE LA SIMULACIÓ-" & sim & " (Base de dades: " & ANOIPPF & ")" End With ReDim nom(1 To 7, 1 To 2), s_r(1 To 7, 1 To 3) For i1 = 1 To 2 nom(1, i1) = "Sim-" & sim & IIf(i1 = 1, "(BI)", "(BL)") nom(2, i1) = "Sim-" & sim & "(QPI)" nom(3, i1) = "Sim-" & sim & "(QPI relativa)" nom(4, i1) = "Equitat" nom(5, i1) = "Ref." & IIf(i1 = 1, "(BI)", "(BL)") nom(6, i1) = "Ref.(QPI)" nom(7, i1) = "Ref.(QPI relativa)" If GP Then ' si hi ha referència s' ha de calcular si les corbes són iguals For i2 = 1 To 3 For j1 = 1 To 12 If Abs(r_g(i2, i1).Columns(j1) - r_g(i2 + 4, i1).Columns(j1)) > 0.005 Then s_r(i2 + 4, i1) = True Exit For End If Next j1 Next i2 For j1 = 1 To 12 If Abs(r_g(1, i1 + 2).Columns(j1) - r_g(2, i1 + 2).Columns(j1)) > 0.001 Then s_r(i1, 3) = True Exit For End If Next j1 End If Next i1 If GP Then ' si hi ha referència s' ha de calcular si les corbes són iguals mmax = Round(Application.Max(r_g(1, 3), r_g(2, 3), r_g(1, 4), r_g(2, 4)), 2) Else mmax = Round(Application.Max(r_g(1, 3), r_g(1, 4)), 2) End If Call COMUNS_41GRAFICS_CORBESLORENZ(fila, GP, "IPPF", nom, r_g, s_r) ' Lorenz Call COMUNS_42GRAFICS_TIPUS(fila + 23, GP, "IPPF", 0, mmax, r_g, s_r, sim) ' Tipus efectius If GP Then If avisgp Then Call COMUNS_43GRAFICS_GP(fila + 46, ANOIPPF, "IPPF", "(R)", r_gp, sim) ' G-P Else GP = False End If End If For i1 = 1 To Worksheets("IPPF(R)").Shapes.Count - 1 Step 2 Worksheets("IPPF(R)").Shapes(i1).Left = 20 ' Reposicionament imatges Next i1 For i1 = 2 To Worksheets("IPPF(R)").Shapes.Count Step 2 Worksheets("IPPF(R)").Shapes(i1).Left = 310 ' Reposicionament imatges Next i1 ActiveWindow.SelectedSheets.HPageBreaks.Add (Cells(fila + 46 + IIf(avisgp, 46, 0), 1)) End Sub VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Inicial Caption = "Impuesto sobre la Renta de las Personas Físicas (IRPF)" ClientHeight = 2460 ClientLeft = 48 ClientTop = 456 ClientWidth = 6912 OleObjectBlob = "Inicial.frx":0000 StartUpPosition = 1 'Centrar en propietario End Attribute VB_Name = "Inicial" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim height1 As Integer, left1 As Integer, top1 As Integer, width1 As Integer Private Sub Aceptar_Click() Dim i As Integer, i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer, i5 As Integer, _ j1 As Integer, k1 As Integer, avis As Boolean, nom1 As String, nom2 As String, _ resposta As VbMsgBoxResult If (Comparacio1 Or Comparacio2 Or Comparacio3 Or Comparacio4 Or Comparacio5) Then i1 = 0 k1 = 0 ERR_LEC = False If Comparacio1 Then i = 1 If Comparacio2 Then i = 2 If Comparacio3 Then i = 3 If Comparacio4 Then i = 4 If Comparacio5 Then i = 5 For j1 = ISIMULS(i) To 1 Step -1 If ListBox61.Selected(j1 - 1) Then If i = 1 Then i1 = CIRPF(ISIMULS(i) - (j1 - 1)) If i = 2 Then i1 = CIS(ISIMULS(i) - (j1 - 1)) If i = 3 Then i1 = CID(ISIMULS(i) - (j1 - 1)) If i = 4 Then i1 = CIT(ISIMULS(i) - (j1 - 1)) If i = 5 Then i1 = CIPPF(ISIMULS(i) - (j1 - 1)) k1 = k1 + 1 End If Next j1 If k1 = 0 Then COMPARA = 0 ERR_LEC = True Me.Hide MsgBox "Debe seleccionar una simulación de la primera lista.", vbCritical, _ IIf(i = 1, TITOL_IRPF, IIf(i = 2, TITOL_IS, IIf(i = 3, TITOL_ID, IIf(i = 4, TITOL_IT, TITOL_IPPF)))) Exit Sub End If If k1 > 1 Then COMPARA = 0 ERR_LEC = True Me.Hide MsgBox "Solo puede seleccionar una simulación de la primera lista.", vbCritical, _ IIf(i = 1, TITOL_IRPF, IIf(i = 2, TITOL_IS, IIf(i = 3, TITOL_ID, IIf(i = 4, TITOL_IT, TITOL_IPPF)))) For j1 = 1 To ISIMULS(i) ListBox61.Selected(j1 - 1) = False ListBox62.Selected(j1 - 1) = False Next j1 Exit Sub End If i2 = 0 k1 = 0 For j1 = ISIMULS(i) To 1 Step -1 If ListBox62.Selected(j1 - 1) Then If i = 1 Then i2 = CIRPF(ISIMULS(i) - (j1 - 1)) If i = 2 Then i2 = CIS(ISIMULS(i) - (j1 - 1)) If i = 3 Then i2 = CID(ISIMULS(i) - (j1 - 1)) If i = 4 Then i2 = CIT(ISIMULS(i) - (j1 - 1)) If i = 5 Then i2 = CIPPF(ISIMULS(i) - (j1 - 1)) k1 = k1 + 1 End If Next j1 If k1 = 0 Then COMPARA = 0 ERR_LEC = True Me.Hide MsgBox "Debe seleccionar una simulación de la segunda lista.", vbCritical, _ IIf(i = 1, TITOL_IRPF, IIf(i = 2, TITOL_IS, IIf(i = 3, TITOL_ID, IIf(i = 4, TITOL_IT, TITOL_IPPF)))) Exit Sub End If If k1 > 1 Then COMPARA = 0 ERR_LEC = True Me.Hide MsgBox "Solo puede seleccionar una simulación de la segunda lista.", vbCritical, _ IIf(i = 1, TITOL_IRPF, IIf(i = 2, TITOL_IS, IIf(i = 3, TITOL_ID, IIf(i = 4, TITOL_IT, TITOL_IPPF)))) For j1 = 1 To ISIMULS(i) ListBox61.Selected(j1 - 1) = False ListBox62.Selected(j1 - 1) = False Next j1 Exit Sub End If If i1 = i2 Then COMPARA = 0 ERR_LEC = True Me.Hide MsgBox "Debe seleccionar una simulación de cada lista, pero distinta.", vbCritical, _ IIf(i = 1, TITOL_IRPF, IIf(i = 2, TITOL_IS, IIf(i = 3, TITOL_ID, IIf(i = 4, TITOL_IT, TITOL_IPPF)))) For j1 = 1 To ISIMULS(i) ListBox61.Selected(j1 - 1) = False ListBox62.Selected(j1 - 1) = False Next j1 Exit Sub End If COMP(1) = i1 COMP(2) = i2 For j1 = 1 To ISIMULS(i) ListBox61.Selected(j1 - 1) = False ListBox62.Selected(j1 - 1) = False Next j1 If i = 1 Then Comparacio1.Value = False If i = 2 Then Comparacio2.Value = False If i = 3 Then Comparacio3.Value = False If i = 4 Then Comparacio4.Value = False If i = 5 Then Comparacio5.Value = False COMPARA = i Unload Me End If If Consulta1 Or Consulta2 Or Consulta3 Or Consulta4 Or Consulta5 Then i1 = 0 i2 = 0 i3 = 0 i4 = 0 i5 = 0 avis = False ERR_LEC = False If Consulta1 Then i = 1 If Consulta2 Then i = 2 If Consulta3 Then i = 3 If Consulta4 Then i = 4 If Consulta5 Then i = 5 For j1 = ISIMULS(i) To 1 Step -1 If ListBox71.Selected(j1 - 1) Then If i = 1 Then i1 = CIRPF(ISIMULS(i) - (j1 - 1)) If i = 2 Then i1 = CIS(ISIMULS(i) - (j1 - 1)) If i = 3 Then i1 = CID(ISIMULS(i) - (j1 - 1)) If i = 4 Then i1 = CIT(ISIMULS(i) - (j1 - 1)) If i = 5 Then i1 = CIPPF(ISIMULS(i) - (j1 - 1)) Exit For End If Next j1 If ISIMULS(i) > 1 Then For j1 = ISIMULS(i) To 1 Step -1 If ListBox72.Selected(j1 - 1) Then If i = 1 Then i2 = CIRPF(ISIMULS(i) - (j1 - 1)) If i = 2 Then i2 = CIS(ISIMULS(i) - (j1 - 1)) If i = 3 Then i2 = CID(ISIMULS(i) - (j1 - 1)) If i = 4 Then i2 = CIT(ISIMULS(i) - (j1 - 1)) If i = 5 Then i2 = CIPPF(ISIMULS(i) - (j1 - 1)) Exit For End If Next j1 If ISIMULS(i) > 2 Then For j1 = ISIMULS(i) To 1 Step -1 If ListBox73.Selected(j1 - 1) Then If i = 1 Then i3 = CIRPF(ISIMULS(i) - (j1 - 1)) If i = 2 Then i3 = CIS(ISIMULS(i) - (j1 - 1)) If i = 3 Then i3 = CID(ISIMULS(i) - (j1 - 1)) If i = 4 Then i3 = CIT(ISIMULS(i) - (j1 - 1)) If i = 5 Then i3 = CIPPF(ISIMULS(i) - (j1 - 1)) Exit For End If Next j1 If ISIMULS(i) > 3 Then For j1 = ISIMULS(i) To 1 Step -1 If ListBox74.Selected(j1 - 1) Then If i = 1 Then i4 = CIRPF(ISIMULS(i) - (j1 - 1)) If i = 2 Then i4 = CIS(ISIMULS(i) - (j1 - 1)) If i = 3 Then i4 = CID(ISIMULS(i) - (j1 - 1)) If i = 4 Then i4 = CIT(ISIMULS(i) - (j1 - 1)) If i = 5 Then i4 = CIPPF(ISIMULS(i) - (j1 - 1)) Exit For End If Next j1 If ISIMULS(i) > 3 Then For j1 = ISIMULS(i) To 1 Step -1 If ListBox75.Selected(j1 - 1) Then If i = 1 Then i5 = CIRPF(ISIMULS(i) - (j1 - 1)) If i = 2 Then i5 = CIS(ISIMULS(i) - (j1 - 1)) If i = 3 Then i5 = CID(ISIMULS(i) - (j1 - 1)) If i = 4 Then i5 = CIT(ISIMULS(i) - (j1 - 1)) If i = 5 Then i5 = CIPPF(ISIMULS(i) - (j1 - 1)) Exit For End If Next j1 End If End If End If End If If i1 = 0 And i2 = 0 And i3 = 0 And i4 = 0 And i5 = 0 Then RES = 0 ERR_LEC = True Me.Hide MsgBox "Debe seleccionar como mínimo una simulación para obtener resultados.", vbCritical, _ IIf(i = 1, TITOL_IRPF, IIf(i = 2, TITOL_IS, IIf(i = 3, TITOL_ID, IIf(i = 4, TITOL_IT, TITOL_IPPF)))) Exit Sub End If j1 = 0 If i1 <> 0 Then j1 = j1 + 1 If i2 <> 0 Then If i2 <> i1 Then j1 = j1 + 1 Else avis = True If i3 <> 0 Then If i3 <> i2 And i3 <> i1 Then j1 = j1 + 1 Else avis = True If i4 <> 0 Then If i4 <> i3 And i4 <> i2 And i4 <> i1 Then j1 = j1 + 1 Else avis = True If i5 <> 0 Then If i5 <> i4 And i5 <> i3 And i5 <> i2 And i5 <> i1 Then j1 = j1 + 1 Else avis = True End If End If End If End If End If If avis Then ERR_LEC = True Me.Hide MsgBox "Alguna de las simulaciones seleccionadas está repetida.", vbCritical, _ IIf(i = 1, TITOL_IRPF, IIf(i = 2, TITOL_IS, IIf(i = 3, TITOL_ID, IIf(i = 4, TITOL_IT, TITOL_IPPF)))) Exit Sub Else ReDim IRESULTS(1 To j1) For j1 = 1 To UBound(IRESULTS) If j1 = 1 Then IRESULTS(j1) = i1 If j1 = 2 Then IRESULTS(j1) = i2 If j1 = 3 Then IRESULTS(j1) = i3 If j1 = 4 Then IRESULTS(j1) = i4 If j1 = 5 Then IRESULTS(j1) = i5 Next j1 End If RES = i Unload Me End If If Gestio1 Or Gestio2 Or Gestio3 Or Gestio4 Or Gestio5 Then i1 = 0 k1 = 0 ERR_LEC = False If Gestio1 Then i = 1 If Gestio2 Then i = 2 If Gestio3 Then i = 3 If Gestio4 Then i = 4 If Gestio5 Then i = 5 For j1 = ISIMULS(i) To 1 Step -1 If ListBox61.Selected(j1 - 1) Then If i = 1 Then i1 = CIRPF(ISIMULS(i) - (j1 - 1)) If i = 2 Then i1 = CIS(ISIMULS(i) - (j1 - 1)) If i = 3 Then i1 = CID(ISIMULS(i) - (j1 - 1)) If i = 4 Then i1 = CIT(ISIMULS(i) - (j1 - 1)) If i = 5 Then i1 = CIPPF(ISIMULS(i) - (j1 - 1)) k1 = k1 + 1 End If Next j1 If k1 = 0 Then ERR_LEC = True Me.Hide MsgBox "Debe seleccionar alguna simulación para eliminar.", vbCritical, _ IIf(i = 1, TITOL_IRPF, IIf(i = 2, TITOL_IS, IIf(i = 3, TITOL_ID, IIf(i = 4, TITOL_IT, TITOL_IPPF)))) Exit Sub End If If k1 > 1 Then ERR_LEC = True Me.Hide MsgBox "Solo puede seleccionar una simulación para eliminar.", vbCritical, _ IIf(i = 1, TITOL_IRPF, IIf(i = 2, TITOL_IS, IIf(i = 3, TITOL_ID, IIf(i = 4, TITOL_IT, TITOL_IPPF)))) For j1 = 1 To ISIMULS(i) ListBox61.Selected(j1 - 1) = False Next j1 Exit Sub End If If i = 1 Then nom1 = NOM_IRPF_SIMUL & "S" & ANOIRPF & "_" If i = 1 Then nom2 = NOM_IRPF_SIMUL & "GP" & ANOIRPF & "_" If i = 2 Then nom1 = NOM_IS_SIMUL & "S" & ANOIS & "_" If i = 2 Then nom2 = NOM_IS_SIMUL & "GP" & ANOIS & "_" If i = 3 Then nom1 = NOM_ID_SIMUL & "S" & ANOID & "_" If i = 3 Then nom2 = NOM_ID_SIMUL & "GP" & ANOID & "_" If i = 4 Then nom1 = NOM_IT_SIMUL & "S" & ANOIT & "_" If i = 4 Then nom2 = NOM_IT_SIMUL & "GP" & ANOIT & "_" If i = 5 Then nom1 = NOM_IPPF_SIMUL & "S" & ANOIPPF & "_" If i = 5 Then nom2 = NOM_IPPF_SIMUL & "GP" & ANOIPPF & "_" For j1 = ISIMULS(i) To 1 Step -1 ERR_LEC = False If ListBox61.Selected(j1 - 1) Then ERR_LEC = True Me.Hide If i = 1 Then i1 = CIRPF(ISIMULS(i) - (j1 - 1)) If i = 2 Then i1 = CIS(ISIMULS(i) - (j1 - 1)) If i = 3 Then i1 = CID(ISIMULS(i) - (j1 - 1)) If i = 4 Then i1 = CIT(ISIMULS(i) - (j1 - 1)) If i = 5 Then i1 = CIPPF(ISIMULS(i) - (j1 - 1)) resposta = MsgBox("Quiere eliminar la Simulación " & i1 & " ?", vbInformation + vbYesNo, _ IIf(i = 1, TITOL_IRPF, IIf(i = 2, TITOL_IS, IIf(i = 3, TITOL_ID, _ IIf(i = 4, TITOL_IT, TITOL_IPPF))))) If resposta = vbYes Then Kill nom1 & Trim(Str(i1)) & ".xlsx" If i <> 4 Then Kill nom2 & Trim(Str(i1)) & ".dat" End If Call COMUNS_0NETEJA(IIf(i = 1, "IRPF(R)", IIf(i = 2, "IS(R)", IIf(i = 3, "ID(R)", _ IIf(i = 4, "ITPOOSAJD(R)", "IPPF(R)"))))) If i = 1 Then Call COMUNS_0NETEJA("IRPF(G-P)") If i = 2 Then Call COMUNS_0NETEJA("IS(G-P)") If i = 3 Then Call COMUNS_0NETEJA("ID(G-P)") If i = 5 Then Call COMUNS_0NETEJA("IPPF(G-P)") Call COMPTADOR1(i) Exit For End If Next j1 For j1 = 1 To ISIMULS(i) ListBox61.Selected(j1 - 1) = False Next j1 For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" Then If Left(CTL.Name, 1) <> "R" Then CTL.Enabled = False If Left(CTL.Name, 1) = "G" Then CTL.Value = False If Left(CTL.Name, 1) = "S" Then CTL.Caption = "Simulació" End If Next CTL With Me .Height = 155 .Top = top1 - ((Me.Height - height1) / 2) End With End If End Sub Private Sub Cancelar_Click() Dim i1 As Integer If IMPOST(1) Then MultiPage1.Value = 0 If IMPOST(2) Then MultiPage1.Value = 1 If IMPOST(3) Then MultiPage1.Value = 2 If IMPOST(4) Then MultiPage1.Value = 3 If IMPOST(5) Then MultiPage1.Value = 4 For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" Then CTL.Value = False If Left(CTL.Name, 1) <> "R" Then CTL.Enabled = False If Left(CTL.Name, 1) = "S" Then CTL.Caption = "Simulación" End If Next CTL Frame6.Visible = False Frame7.Visible = False IMPOST(1) = False IMPOST(2) = False IMPOST(3) = False IMPOST(4) = False IMPOST(5) = False COMPARA = 0 RES = 0 SIMUL = 0 For i1 = 1 To Application.Max(ISIMULS(1), ISIMULS(2), ISIMULS(3), ISIMULS(4), ISIMULS(5)) If ListBox61.Selected(i1 - 1) Then ListBox61.Selected(i1 - 1) = False If ListBox62.Selected(i1 - 1) Then ListBox62.Selected(i1 - 1) = False If ListBox71.Selected(i1 - 1) Then ListBox71.Selected(i1 - 1) = False If ListBox72.Selected(i1 - 1) Then ListBox72.Selected(i1 - 1) = False If ListBox73.Selected(i1 - 1) Then ListBox73.Selected(i1 - 1) = False If ListBox74.Selected(i1 - 1) Then ListBox74.Selected(i1 - 1) = False If ListBox75.Selected(i1 - 1) Then ListBox75.Selected(i1 - 1) = False Next i1 For i1 = 1 To Application.Max(AIRPF, AIS, AID, AIT, AIPPF) If ListBox_IRPF.Selected(i1 - 1) Then ListBox_IRPF.Selected(i1 - 1) = False If ListBox_IS.Selected(i1 - 1) Then ListBox_IS.Selected(i1 - 1) = False If ListBox_ID.Selected(i1 - 1) Then ListBox_ID.Selected(i1 - 1) = False If ListBox_IT.Selected(i1 - 1) Then ListBox_IT.Selected(i1 - 1) = False If ListBox_IPPF.Selected(i1 - 1) Then ListBox_IPPF.Selected(i1 - 1) = False Next i1 ListBox72.Locked = True ListBox73.Locked = True ListBox74.Locked = True ListBox75.Locked = True With Me .Height = 155 .Top = top1 - ((Me.Height - height1) / 2) End With End Sub Private Sub Comparacio1_Click() Dim s() As String If Comparacio1.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Comparacio1" Then CTL.Value = False Next CTL ERR_LEC = False Call COMPTADOR2("Comparacio", 1, s) With Me With .Frame6 .Caption = "Comparar:" .Frame61.Left = 2 .Frame62.Visible = True .Label6.Visible = True .ListBox61.List = s .ListBox61.TopIndex = ISIMULS(1) .ListBox62.List = s .ListBox62.TopIndex = ISIMULS(1) .Visible = True End With .Frame7.Visible = False For Each CTL In .Frame7.Controls If TypeName(CTL) = "Frame" And CTL.Name <> "Frame71" Then CTL.Visible = False Next CTL .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With Call COMUNS_0NETEJA("IRPF(G-P)") End If End Sub Private Sub Comparacio2_Click() Dim s() As String If Comparacio2.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Comparacio2" Then CTL.Value = False Next CTL ERR_LEC = False Call COMPTADOR2("Comparacio", 2, s) With Me With .Frame6 .Caption = "Comparar:" .Frame61.Left = 2 .Frame62.Visible = True .Label6.Visible = True .ListBox61.List = s .ListBox61.TopIndex = ISIMULS(2) .ListBox62.List = s .ListBox62.TopIndex = ISIMULS(2) .Visible = True End With .Frame7.Visible = False For Each CTL In .Frame7.Controls If TypeName(CTL) = "Frame" And CTL.Name <> "Frame71" Then CTL.Visible = False Next CTL .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With Call COMUNS_0NETEJA("IS(G-P)") End If End Sub Private Sub Comparacio3_Click() Dim s() As String If Comparacio3.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Comparacio3" Then CTL.Value = False Next CTL ERR_LEC = False Call COMPTADOR2("Comparacio", 3, s) With Me With .Frame6 .Caption = "Comparar:" .Frame61.Left = 2 .Frame62.Visible = True .Label6.Visible = True .ListBox61.List = s .ListBox61.TopIndex = ISIMULS(3) .ListBox62.List = s .ListBox62.TopIndex = ISIMULS(3) .Visible = True End With .Frame7.Visible = False For Each CTL In .Frame7.Controls If TypeName(CTL) = "Frame" And CTL.Name <> "Frame71" Then CTL.Visible = False Next CTL .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With Call COMUNS_0NETEJA("ID(G-P)") End If End Sub Private Sub Comparacio4_Click() Dim s() As String If Comparacio4.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Comparacio4" Then CTL.Value = False Next CTL ERR_LEC = False Call COMPTADOR2("Comparacio", 4, s) With Me With .Frame6 .Caption = "Comparar:" .Frame61.Left = 2 .Frame62.Visible = True .Label6.Visible = True .ListBox61.List = s .ListBox61.TopIndex = ISIMULS(4) .ListBox62.List = s .ListBox62.TopIndex = ISIMULS(4) .Visible = True End With .Frame7.Visible = False For Each CTL In .Frame7.Controls If TypeName(CTL) = "Frame" And CTL.Name <> "Frame71" Then CTL.Visible = False Next CTL .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With Call COMUNS_0NETEJA("ITPOOSAJD(G-P)") End If End Sub Private Sub Comparacio5_Click() Dim s() As String If Comparacio5.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Comparacio5" Then CTL.Value = False Next CTL ERR_LEC = False Call COMPTADOR2("Comparacio", 5, s) With Me With .Frame6 .Caption = "Comparar:" .Frame61.Left = 2 .Frame62.Visible = True .Label6.Visible = True .ListBox61.List = s .ListBox61.TopIndex = ISIMULS(5) .ListBox62.List = s .ListBox62.TopIndex = ISIMULS(5) .Visible = True End With .Frame7.Visible = False For Each CTL In .Frame7.Controls If TypeName(CTL) = "Frame" And CTL.Name <> "Frame71" Then CTL.Visible = False Next CTL .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With Call COMUNS_0NETEJA("IPPF(G-P)") End If End Sub Private Sub Consulta1_Click() Dim i1 As Integer, s() As String If Consulta1.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Consulta1" Then CTL.Value = False Next CTL ERR_LEC = False For i1 = 1 To Application.Max(ISIMULS(1), ISIMULS(2), ISIMULS(3), ISIMULS(4), ISIMULS(5)) If ListBox61.Selected(i1 - 1) Then ListBox61.Selected(i1 - 1) = False If ListBox62.Selected(i1 - 1) Then ListBox62.Selected(i1 - 1) = False Next i1 Call COMPTADOR2("Consulta", 1, s) With Me .Frame6.Visible = False With .Frame7 .ListBox71.List = s .ListBox72.List = s .ListBox73.List = s .ListBox74.List = s .ListBox75.List = s .ListBox71.TopIndex = ISIMULS(1) If ISIMULS(1) > 1 Then .Frame72.Visible = True .ListBox72.TopIndex = ISIMULS(1) - 2 If ISIMULS(1) > 2 Then .Frame73.Visible = True .ListBox73.TopIndex = ISIMULS(1) - 3 If ISIMULS(1) > 3 Then .Frame74.Visible = True .ListBox74.TopIndex = ISIMULS(1) - 4 If ISIMULS(1) > 4 Then .Frame75.Visible = True .ListBox75.TopIndex = ISIMULS(1) - 5 End If End If End If End If .Visible = True End With .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With Call COMUNS_0NETEJA("IRPF(R)") End If End Sub Private Sub Consulta2_Click() Dim i1 As Integer, s() As String If Consulta2.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Consulta2" Then CTL.Value = False Next CTL ERR_LEC = False For i1 = 1 To Application.Max(ISIMULS(1), ISIMULS(2), ISIMULS(3), ISIMULS(4), ISIMULS(5)) If ListBox61.Selected(i1 - 1) Then ListBox61.Selected(i1 - 1) = False If ListBox62.Selected(i1 - 1) Then ListBox62.Selected(i1 - 1) = False Next i1 Call COMPTADOR2("Consulta", 2, s) With Me .Frame6.Visible = False With .Frame7 .ListBox71.List = s .ListBox72.List = s .ListBox73.List = s .ListBox74.List = s .ListBox75.List = s .ListBox71.TopIndex = ISIMULS(2) .ListBox71.Visible = True If ISIMULS(2) > 1 Then .Frame72.Visible = True .ListBox72.TopIndex = ISIMULS(2) - 2 If ISIMULS(2) > 2 Then .Frame73.Visible = True .ListBox73.TopIndex = ISIMULS(2) - 3 If ISIMULS(2) > 3 Then .Frame74.Visible = True .ListBox74.TopIndex = ISIMULS(2) - 4 If ISIMULS(2) > 4 Then .Frame75.Visible = True .ListBox75.TopIndex = ISIMULS(2) - 5 End If End If End If End If .Visible = True End With .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With Call COMUNS_0NETEJA("IS(R)") End If End Sub Private Sub Consulta3_Click() Dim i1 As Integer, s() As String If Consulta3.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Consulta3" Then CTL.Value = False Next CTL ERR_LEC = False For i1 = 1 To Application.Max(ISIMULS(1), ISIMULS(2), ISIMULS(3), ISIMULS(4), ISIMULS(5)) If ListBox61.Selected(i1 - 1) Then ListBox61.Selected(i1 - 1) = False If ListBox62.Selected(i1 - 1) Then ListBox62.Selected(i1 - 1) = False Next i1 Call COMPTADOR2("Consulta", 3, s) With Me .Frame6.Visible = False With .Frame7 .ListBox71.List = s .ListBox72.List = s .ListBox73.List = s .ListBox74.List = s .ListBox75.List = s .ListBox71.TopIndex = ISIMULS(3) If ISIMULS(3) > 1 Then .Frame72.Visible = True .ListBox72.TopIndex = ISIMULS(3) - 2 If ISIMULS(3) > 2 Then .Frame73.Visible = True .ListBox73.TopIndex = ISIMULS(3) - 3 If ISIMULS(3) > 3 Then .Frame74.Visible = True .ListBox74.TopIndex = ISIMULS(3) - 4 If ISIMULS(3) > 4 Then .Frame75.Visible = True .ListBox75.TopIndex = ISIMULS(3) - 5 End If End If End If End If .Visible = True End With .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With Call COMUNS_0NETEJA("ID(R)") End If End Sub Private Sub Consulta4_Click() Dim i1 As Integer, s() As String If Consulta4.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Consulta4" Then CTL.Value = False Next CTL ERR_LEC = False For i1 = 1 To Application.Max(ISIMULS(1), ISIMULS(2), ISIMULS(3), ISIMULS(4), ISIMULS(5)) If ListBox61.Selected(i1 - 1) Then ListBox61.Selected(i1 - 1) = False If ListBox62.Selected(i1 - 1) Then ListBox62.Selected(i1 - 1) = False Next i1 Call COMPTADOR2("Consulta", 4, s) With Me .Frame6.Visible = False With .Frame7 .ListBox71.List = s .ListBox72.List = s .ListBox73.List = s .ListBox74.List = s .ListBox75.List = s .ListBox71.TopIndex = ISIMULS(4) If ISIMULS(4) > 1 Then .Frame72.Visible = True .ListBox72.TopIndex = ISIMULS(4) - 2 If ISIMULS(4) > 2 Then .Frame73.Visible = True .ListBox73.TopIndex = ISIMULS(4) - 3 If ISIMULS(4) > 3 Then .Frame74.Visible = True .ListBox74.TopIndex = ISIMULS(4) - 4 If ISIMULS(4) > 4 Then .Frame75.Visible = True .ListBox75.TopIndex = ISIMULS(4) - 5 End If End If End If End If .Visible = True End With .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With Call COMUNS_0NETEJA("ITPOOSAJD(R)") End If End Sub Private Sub Consulta5_Click() Dim i1 As Integer, s() As String If Consulta5.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Consulta5" Then CTL.Value = False Next CTL ERR_LEC = False For i1 = 1 To Application.Max(ISIMULS(1), ISIMULS(2), ISIMULS(3), ISIMULS(4), ISIMULS(5)) If ListBox61.Selected(i1 - 1) Then ListBox61.Selected(i1 - 1) = False If ListBox62.Selected(i1 - 1) Then ListBox62.Selected(i1 - 1) = False Next i1 Call COMPTADOR2("Consulta", 5, s) With Me .Frame6.Visible = False With .Frame7 .ListBox71.List = s .ListBox72.List = s .ListBox73.List = s .ListBox74.List = s .ListBox75.List = s .ListBox71.TopIndex = ISIMULS(5) If ISIMULS(5) > 1 Then .Frame72.Visible = True .ListBox72.TopIndex = ISIMULS(5) - 2 If ISIMULS(5) > 2 Then .Frame73.Visible = True .ListBox73.TopIndex = ISIMULS(5) - 3 If ISIMULS(5) > 3 Then .Frame74.Visible = True .ListBox74.TopIndex = ISIMULS(5) - 4 If ISIMULS(5) > 4 Then .Frame75.Visible = True .ListBox75.TopIndex = ISIMULS(5) - 5 End If End If End If End If .Visible = True End With .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With Call COMUNS_0NETEJA("IPPF(R)") End If End Sub Private Sub Gestio1_Click() Dim s() As String If Gestio1.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Gestio1" Then CTL.Value = False Next CTL ERR_LEC = False Call COMPTADOR2("Gestio", 1, s) With Me With .Frame6 .Caption = "Eliminar:" .Frame61.Left = 60 .Frame62.Visible = False .Label6.Visible = False .ListBox61.List = s .ListBox61.TopIndex = ISIMULS(1) .Visible = True End With .Frame7.Visible = False For Each CTL In .Frame7.Controls If TypeName(CTL) = "Frame" And CTL.Name <> "Frame71" Then CTL.Visible = False Next CTL .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With End If End Sub Private Sub Gestio2_Click() Dim s() As String If Gestio2.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Gestio2" Then CTL.Value = False Next CTL ERR_LEC = False Call COMPTADOR2("Gestio", 2, s) With Me With .Frame6 .Caption = "Eliminar:" .Frame61.Left = 60 .Frame62.Visible = False .Label6.Visible = False .ListBox61.List = s .ListBox61.TopIndex = ISIMULS(2) .Visible = True End With .Frame7.Visible = False For Each CTL In .Frame7.Controls If TypeName(CTL) = "Frame" And CTL.Name <> "Frame71" Then CTL.Visible = False Next CTL .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With End If End Sub Private Sub Gestio3_Click() Dim s() As String If Gestio3.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Gestio3" Then CTL.Value = False Next CTL ERR_LEC = False Call COMPTADOR2("Gestio", 3, s) With Me With .Frame6 .Caption = "Eliminar:" .Frame61.Left = 60 .Frame62.Visible = False .Label6.Visible = False .ListBox61.List = s .ListBox61.TopIndex = ISIMULS(3) .Visible = True End With .Frame7.Visible = False For Each CTL In .Frame7.Controls If TypeName(CTL) = "Frame" And CTL.Name <> "Frame71" Then CTL.Visible = False Next CTL .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With End If End Sub Private Sub Gestio4_Click() Dim s() As String If Gestio4.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Gestio4" Then CTL.Value = False Next CTL ERR_LEC = False Call COMPTADOR2("Gestio", 4, s) With Me With .Frame6 .Caption = "Eliminar:" .Frame61.Left = 60 .Frame62.Visible = False .Label6.Visible = False .ListBox61.List = s .ListBox61.TopIndex = ISIMULS(4) .Visible = True End With .Frame7.Visible = False For Each CTL In .Frame7.Controls If TypeName(CTL) = "Frame" And CTL.Name <> "Frame71" Then CTL.Visible = False Next CTL .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With End If End Sub Private Sub Gestio5_Click() Dim s() As String If Gestio5.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And CTL.Name <> "Gestio5" Then CTL.Value = False Next CTL ERR_LEC = False Call COMPTADOR2("Gestio", 5, s) With Me With .Frame6 .Caption = "Eliminar:" .Frame61.Left = 60 .Frame62.Visible = False .Label6.Visible = False .ListBox61.List = s .ListBox61.TopIndex = ISIMULS(5) .Visible = True End With .Frame7.Visible = False For Each CTL In .Frame7.Controls If TypeName(CTL) = "Frame" And CTL.Name <> "Frame71" Then CTL.Visible = False Next CTL .Height = 223 .Top = top1 - ((.Height - height1) / 2) End With End If End Sub Private Sub Simula1_Click() Dim i1 As Integer, nom1 As String, nom2 As String, resposta As VbMsgBoxResult If Simula1.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" Then CTL.Value = False Next CTL ERR_LEC = False If ISIMULS(1) <> 0 Then If CIRPF(ISIMULS(1)) = 100 Then ERR_LEC = True nom1 = NOM_IRPF_SIMUL & "S" & ANOIRPF & "_" nom2 = NOM_IRPF_SIMUL & "GP" & ANOIRPF & "_" Me.Hide resposta = MsgBox("El contador de simulaciones ha alcanzado su límite (100). Si quiere obtener " & vbCr & _ "más simulaciones debe eliminar todas las que están almacenadas." & vbCr & vbCr & _ "¿Quiere eliminar todas las simulaciones existentes definitivamente ?", vbInformation + vbYesNo, TITOL_IRPF) If resposta = vbYes Then For i1 = 1 To ISIMULS(1) If Dir(nom1 & Trim(Str(CIRPF(i1))) & ".xlsx") Then Kill nom1 & Trim(Str(CIRPF(i1))) & ".xlsx" If Dir(nom2 & Trim(Str(CIRPF(i1))) & ".dat") Then Kill nom2 & Trim(Str(CIRPF(i1))) & ".dat" Next i1 Else SIMUL = 0 Unload Me Exit Sub End If End If Call COMUNS_0NETEJA("IRPF(R)") End If SIMUL = 1 Unload Me End If End Sub Private Sub Simula2_Click() Dim i1 As Integer, nom1 As String, nom2 As String, resposta As VbMsgBoxResult If Simula2.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" Then CTL.Value = False Next CTL ERR_LEC = False If ISIMULS(2) <> 0 Then If CIS(ISIMULS(2)) = 100 Then ERR_LEC = True nom1 = NOM_IS_SIMUL & "S" & ANOIS & "_" nom2 = NOM_IS_SIMUL & "GP" & ANOIS & "_" Me.Hide resposta = MsgBox("El contador de simulaciones ha alcanzado su límite (100). Si quiere obtener " & vbCr & _ "más simulaciones debe eliminar todas las que están almacenadas." & vbCr & vbCr & _ "¿Quiere eliminar todas las simulaciones existentes definitivamente?", vbInformation + vbYesNo, TITOL_IS) If resposta = vbYes Then For i1 = 1 To ISIMULS(2) If Dir(nom1 & Trim(Str(CIS(i1))) & ".xlsx") Then Kill nom1 & Trim(Str(CIS(i1))) & ".xlsx" If Dir(nom2 & Trim(Str(CIS(i1))) & ".dat") Then Kill nom2 & Trim(Str(CIS(i1))) & ".dat" Next i1 Else SIMUL = 0 Unload Me Exit Sub End If End If Call COMUNS_0NETEJA("IS(R)") End If SIMUL = 2 Unload Me End If End Sub Private Sub Simula3_Click() Dim i1 As Integer, nom1 As String, nom2 As String, resposta As VbMsgBoxResult If Simula3.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" Then CTL.Value = False Next CTL ERR_LEC = False If ISIMULS(3) <> 0 Then If CID(ISIMULS(3)) = 100 Then ERR_LEC = True nom1 = NOM_ID_SIMUL & "S" & ANOID & "_" nom2 = NOM_ID_SIMUL & "GP" & ANOID & "_" Me.Hide resposta = MsgBox("El contador de simulaciones ha alcanzado su límite (100). Si quiere obtener " & vbCr & _ "más simulaciones debe eliminar todas las que están almacenadas." & vbCr & vbCr & _ "¿Quiere eliminar todas las simulaciones existentes definitivamente?", vbInformation + vbYesNo, TITOL_ID) If resposta = vbYes Then For i1 = 1 To ISIMULS(3) If Dir(nom1 & Trim(Str(CID(i1))) & ".xlsx") Then Kill nom1 & Trim(Str(CID(i1))) & ".xlsx" If Dir(nom2 & Trim(Str(CID(i1))) & ".dat") Then Kill nom2 & Trim(Str(CID(i1))) & ".dat" Next i1 Else SIMUL = 0 Unload Me Exit Sub End If End If Call COMUNS_0NETEJA("ID(R)") End If SIMUL = 3 Unload Me End If End Sub Private Sub Simula4_Click() Dim i1 As Integer, nom1 As String, nom2 As String, resposta As VbMsgBoxResult If Simula4.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" Then CTL.Value = False Next CTL ERR_LEC = False If ISIMULS(4) <> 0 Then If CIT(ISIMULS(4)) = 100 Then ERR_LEC = True nom1 = NOM_IT_SIMUL & "S" & ANOIT & "_" Me.Hide resposta = MsgBox("El contador de simulaciones ha alcanzado su límite (100). Si quiere obtener " & vbCr & _ "más simulaciones debe eliminar todas las que están almacenadas." & vbCr & vbCr & _ "¿Quiere eliminar todas las simulaciones existentes definitivamente?", vbInformation + vbYesNo, TITOL_IT) If resposta = vbYes Then For i1 = 1 To ISIMULS(4) If Dir(nom1 & Trim(Str(CIT(i1))) & ".xlsx") Then Kill nom1 & Trim(Str(CIT(i1))) & ".xlsx" Next i1 Else SIMUL = 0 Unload Me Exit Sub End If End If Call COMUNS_0NETEJA("ITPOOSAJD(R)") End If SIMUL = 4 Unload Me End If End Sub Private Sub Simula5_Click() Dim i1 As Integer, nom1 As String, nom2 As String, resposta As VbMsgBoxResult If Simula5.Value Then For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" Then CTL.Value = False Next CTL ERR_LEC = False If ISIMULS(5) <> 0 Then If CIPPF(ISIMULS(5)) = 100 Then ERR_LEC = True nom1 = NOM_IPPF_SIMUL & "S" & ANOIPPF & "_" Me.Hide resposta = MsgBox("El contador de simulaciones ha alcanzado su límite (100). Si quiere obtener " & vbCr & _ "más simulaciones debe eliminar todas las que están almacenadas." & vbCr & vbCr & _ "¿Quiere eliminar todas las simulaciones existentes definitivamente?", vbInformation + vbYesNo, TITOL_IPPF) If resposta = vbYes Then For i1 = 1 To ISIMULS(5) If Dir(nom1 & Trim(Str(CIPPF(i1))) & ".xlsx") Then Kill nom1 & Trim(Str(CIPPF(i1))) & ".xlsx" If Dir(nom2 & Trim(Str(CIPPF(i1))) & ".dat") Then Kill nom2 & Trim(Str(CIPPF(i1))) & ".dat" Next i1 Else SIMUL = 0 Unload Me Exit Sub End If End If Call COMUNS_0NETEJA("IPPF(R)") End If SIMUL = 5 Unload Me End If End Sub Private Sub ListBox_IRPF_Click() Dim i1 As Integer For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And Left(CTL.Name, 1) <> "R" Then CTL.Enabled = False CTL.Value = False End If Next CTL For i1 = 1 To Application.Max(AIRPF, AIS, AID, AIT, AIPPF) ListBox_IS.Selected(i1 - 1) = False ListBox_ID.Selected(i1 - 1) = False ListBox_IT.Selected(i1 - 1) = False ListBox_IPPF.Selected(i1 - 1) = False If ListBox_IRPF.Selected(i1 - 1) = True Then ANOIRPF = ListBox_IRPF.Value Exit For End If Next i1 Call COMPTADOR1(1) With Me With .Simula1 .Caption = "Simulación (" & ISIMULS(1) & " almacenad" & IIf(ISIMULS(1) = 1, "a)", "as)") .Enabled = True End With If ISIMULS(1) <> 0 Then If ISIMULS(1) > 1 Then .Comparacio1.Enabled = True .Consulta1.Enabled = True .Gestio1.Enabled = True End If .Height = 155 .Top = top1 - ((Me.Height - height1) / 2) End With End Sub Private Sub ListBox_IS_Click() Dim i1 As Integer For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And Left(CTL.Name, 1) <> "R" Then CTL.Enabled = False CTL.Value = False End If Next CTL For i1 = 1 To Application.Max(AIRPF, AIS, AID, AIT, AIPPF) ListBox_IRPF.Selected(i1 - 1) = False ListBox_ID.Selected(i1 - 1) = False ListBox_IT.Selected(i1 - 1) = False ListBox_IPPF.Selected(i1 - 1) = False If ListBox_IS.Selected(i1 - 1) = True Then ANOIS = ListBox_IS.Value Exit For End If Next i1 Call COMPTADOR1(2) With Me With .Simula2 .Caption = "Simulación (" & ISIMULS(2) & " almacenad" & IIf(ISIMULS(2) = 1, "a)", "as)") .Enabled = True End With If ISIMULS(2) <> 0 Then If ISIMULS(2) > 1 Then .Comparacio2.Enabled = True .Consulta2.Enabled = True .Gestio2.Enabled = True End If .Height = 155 .Top = top1 - ((Me.Height - height1) / 2) End With End Sub Private Sub ListBox_ID_Click() Dim i1 As Integer For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And Left(CTL.Name, 1) <> "R" Then CTL.Enabled = False CTL.Value = False End If Next CTL For i1 = 1 To Application.Max(AIRPF, AIS, AID, AIT, AIPPF) ListBox_IRPF.Selected(i1 - 1) = False ListBox_IS.Selected(i1 - 1) = False ListBox_IT.Selected(i1 - 1) = False ListBox_IPPF.Selected(i1 - 1) = False If ListBox_ID.Selected(i1 - 1) = True Then ANOID = ListBox_ID.Value Exit For End If Next i1 Call COMPTADOR1(3) With Me With .Simula3 .Caption = "Simulación (" & ISIMULS(3) & " almacenad" & IIf(ISIMULS(2) = 1, "a)", "as)") .Enabled = True End With If ISIMULS(3) <> 0 Then If ISIMULS(3) > 1 Then .Comparacio3.Enabled = True .Consulta3.Enabled = True .Gestio3.Enabled = True End If .Height = 155 .Top = top1 - ((Me.Height - height1) / 2) End With End Sub Private Sub ListBox_IT_Click() Dim i1 As Integer For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And Left(CTL.Name, 1) <> "R" Then CTL.Enabled = False CTL.Value = False End If Next CTL For i1 = 1 To Application.Max(AIRPF, AIS, AID, AIT, AIPPF) ListBox_IRPF.Selected(i1 - 1) = False ListBox_IS.Selected(i1 - 1) = False ListBox_ID.Selected(i1 - 1) = False ListBox_IPPF.Selected(i1 - 1) = False If ListBox_IT.Selected(i1 - 1) = True Then ANOIT = ListBox_IT.Value Exit For End If Next i1 Call COMPTADOR1(4) With Me With .Simula4 .Caption = "Simulación (" & ISIMULS(4) & " almacenad" & IIf(ISIMULS(2) = 1, "a)", "as)") .Enabled = True End With If ISIMULS(4) <> 0 Then If ISIMULS(4) > 1 Then .Comparacio4.Enabled = True .Consulta4.Enabled = True .Gestio4.Enabled = True End If .Height = 155 .Top = top1 - ((Me.Height - height1) / 2) End With End Sub Private Sub ListBox_IPPF_Click() Dim i1 As Integer For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And Left(CTL.Name, 1) <> "R" Then CTL.Enabled = False CTL.Value = False End If Next CTL For i1 = 1 To Application.Max(AIRPF, AIS, AID, AIT, AIPPF) ListBox_IRPF.Selected(i1 - 1) = False ListBox_IS.Selected(i1 - 1) = False ListBox_ID.Selected(i1 - 1) = False ListBox_IT.Selected(i1 - 1) = False If ListBox_IPPF.Selected(i1 - 1) = True Then ANOIPPF = ListBox_IPPF.Value Exit For End If Next i1 Call COMPTADOR1(5) With Me With .Simula5 .Caption = "Simulación (" & ISIMULS(5) & " almacenad" & IIf(ISIMULS(2) = 1, "a)", "as)") .Enabled = True End With If ISIMULS(5) <> 0 Then If ISIMULS(5) > 1 Then .Comparacio5.Enabled = True .Consulta5.Enabled = True .Gestio5.Enabled = True End If .Height = 155 .Top = top1 - ((Me.Height - height1) / 2) End With End Sub Private Sub ListBox71_Click() Dim j1 As Integer For j1 = 1 To ISIMULS(MultiPage1.Value + 1) If ListBox71.Selected(j1 - 1) Then ListBox72.Locked = False Exit For End If Next j1 End Sub Private Sub ListBox72_Click() Dim j1 As Integer For j1 = 1 To ISIMULS(MultiPage1.Value + 1) If ListBox72.Selected(j1 - 1) Then ListBox73.Locked = False Exit For End If Next j1 End Sub Private Sub ListBox73_Click() Dim j1 As Integer For j1 = 1 To ISIMULS(MultiPage1.Value + 1) If ListBox73.Selected(j1 - 1) Then ListBox74.Locked = False Exit For End If Next j1 End Sub Private Sub ListBox74_Click() Dim j1 As Integer For j1 = 1 To ISIMULS(MultiPage1.Value + 1) If ListBox74.Selected(j1 - 1) Then ListBox75.Locked = False Exit For End If Next j1 End Sub Private Sub MultiPage1_Change() Dim i1 As Integer With Me .Height = 155 .Top = top1 - ((Me.Height - height1) / 2) End With For i1 = 0 To Application.Max(ISIMULS(1), ISIMULS(2), ISIMULS(3), ISIMULS(4), ISIMULS(5)) ListBox61.Selected(i1) = False ListBox62.Selected(i1) = False Next i1 For Each CTL In Me.Controls If TypeName(CTL) = "OptionButton" And Left(CTL.Name, 1) <> "R" Then CTL.Enabled = False CTL.Value = False End If Next CTL For i1 = 1 To 5 IMPOST(i1) = False If MultiPage1.Value = i1 - 1 Then If i1 = 1 Then IMPOST(1) = True Caption = "Impuesto sobre la Renta de las Personas Físicas (IRPF)" ListBox_IRPF.List = AIRPF ElseIf i1 = 2 Then IMPOST(2) = True Caption = "Impost sobre Sucesiones (IS)" ListBox_IS.List = AIS ElseIf i1 = 3 Then IMPOST(3) = True Caption = "Impost sobre Donaciones (ID)" ListBox_ID.List = AID ElseIf i1 = 4 Then IMPOST(4) = True Caption = "Transmisiones patrimoniales. Operaciones societarias. Actos jurídicos (ITPOOSAJD)" ListBox_IT.List = AIT ElseIf i1 = 5 Then IMPOST(5) = True Caption = "Impuesto sobre el Patrimonio de las Personas Físicas (IPPF)" ListBox_IPPF.List = AIPPF End If End If Next i1 End Sub Private Sub UserForm_Activate() height1 = Me.Height left1 = Me.Left top1 = Me.Top width1 = Me.Width End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then SORTIR = True Unload Me End Sub Private Sub UserForm_Zoom(Percent As Integer) Me.Width = Me.Width * Percent / 100 Me.Height = Me.Height * Percent / 100 Me.Left = left1 - ((Me.Width - width1) / 2) End Sub Private Sub COMPTADOR1(opcio As Integer) Dim i1 As Integer, i2 As Integer, i3 As Integer, j1 As Integer, nom As String If ISIMULS(opcio) <> 0 Then For j1 = 1 To ISIMULS(opcio) If ListBox61.Selected(j1 - 1) Then ListBox61.Selected(j1 - 1) = False If ListBox62.Selected(j1 - 1) Then ListBox62.Selected(j1 - 1) = False Next j1 End If If opcio = 1 Then nom = NOM_IRPF_SIMUL & "S" & ANOIRPF & "_" If opcio = 2 Then nom = NOM_IS_SIMUL & "S" & ANOIS & "_" If opcio = 3 Then nom = NOM_ID_SIMUL & "S" & ANOID & "_" If opcio = 4 Then nom = NOM_IT_SIMUL & "S" & ANOIT & "_" If opcio = 5 Then nom = NOM_IPPF_SIMUL & "S" & ANOIPPF & "_" ISIMULS(opcio) = 0 For i1 = 1 To 100 If Dir(nom & Trim(Str(i1)) & ".xlsx") <> "" Then ISIMULS(opcio) = ISIMULS(opcio) + 1 Next i1 If ISIMULS(opcio) <> 0 Then If opcio = 1 Then ReDim CIRPF(1 To ISIMULS(opcio)) If opcio = 2 Then ReDim CIS(1 To ISIMULS(opcio)) If opcio = 3 Then ReDim CID(1 To ISIMULS(opcio)) If opcio = 4 Then ReDim CIT(1 To ISIMULS(opcio)) If opcio = 5 Then ReDim CIPPF(1 To ISIMULS(opcio)) i2 = 1 i1 = 1 TORNA: If Dir(nom & Trim(Str(i1)) & ".xlsx") <> "" Then If opcio = 1 Then CIRPF(i2) = i1 If opcio = 2 Then CIS(i2) = i1 If opcio = 3 Then CID(i2) = i1 If opcio = 4 Then CIT(i2) = i1 If opcio = 5 Then CIPPF(i2) = i1 i2 = i2 + 1 End If i1 = i1 + 1 If i1 <= 100 Or i2 < ISIMULS(opcio) Then GoTo TORNA Else If opcio = 1 Then ReDim CIRPF(0) If opcio = 2 Then ReDim CIS(0) If opcio = 3 Then ReDim CID(0) If opcio = 4 Then ReDim CIT(0) If opcio = 5 Then ReDim CIPPF(0) End If End Sub Private Sub COMPTADOR2(opcio1 As String, opcio2 As Integer, s) Dim i1 As Integer, i2 As Integer, i3 As Integer, nom As String ReDim s(1 To ISIMULS(opcio2)) If opcio1 <> "Consulta" Then If opcio2 = 1 Then nom = NOM_IRPF_SIMUL & "S" & ANOIRPF & "_" If opcio2 = 2 Then nom = NOM_IS_SIMUL & "S" & ANOIS & "_" If opcio2 = 3 Then nom = NOM_ID_SIMUL & "S" & ANOID & "_" If opcio2 = 4 Then nom = NOM_IT_SIMUL & "S" & ANOIT & "_" If opcio2 = 5 Then nom = NOM_IPPF_SIMUL & "S" & ANOIPPF & "_" End If i2 = 0 i1 = ISIMULS(opcio2) TORNA: If opcio2 = 1 Then i3 = CIRPF(i1) If opcio2 = 2 Then i3 = CIS(i1) If opcio2 = 3 Then i3 = CID(i1) If opcio2 = 4 Then i3 = CIT(i1) If opcio2 = 5 Then i3 = CIPPF(i1) If opcio1 <> "Consulta" Then If Dir(nom & Trim(Str(i3)) & ".xlsx") <> "" Then i2 = i2 + 1 s(i2) = "Simulación " & i3 End If Else i2 = i2 + 1 s(i2) = Trim(Str(i3)) End If i1 = i1 - 1 If i2 < ISIMULS(opcio2) Then GoTo TORNA End Sub VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} IPPF Caption = "IPPF" ClientHeight = 8415 ClientLeft = 48 ClientTop = 456 ClientWidth = 11448 OleObjectBlob = "IPPF.frx":0000 StartUpPosition = 1 'Centrar en propietario End Attribute VB_Name = "IPPF" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim height1 As Integer, left1 As Integer, top1 As Integer, width1 As Integer Private Sub Aceptar_Click() Dim i1 As Integer ERR_LEC = False If MultiPage1.Value = 0 Then ReDim BENS_E(1 To 22) For Each CTL In Frame11.Controls For i1 = 1 To 22 If CTL.Name = "CheckBox11" & i1 Then If CTL.Value Then BENS_E(i1) = 1 End If Next i1 Next CTL If WorksheetFunction.Sum(BENS_E) = 22 Then ERR_LEC = True Me.Hide MsgBox "Com a mínim algún bé o dret ha de ser no exempt.", vbCritical, TITOL_IPPF Exit Sub End If ReDim MINIMS_E(1 To 22) For Each CTL In Frame13.Controls For i1 = 1 To 22 If CTL.Name = "TextBox13" & i1 Then If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) > 750000) Then ERR_LEC = True Me.Hide MsgBox "Error en el mínim exempt de l'epígraf: ''" & LVAR(i1) & "''. No pot ser negatiu ni superior a 750000€.", vbCritical, TITOL_IPPF Exit Sub Else MINIMS_E(i1) = Val(Replace(CTL.Value, ",", ".")) End If End If Next i1 Next CTL '''''''''''''''''''''''''''''''''''''''' 'Guarda els paràmetres del primer quadre '''''''''''''''''''''''''''''''''''''''' ReDim PARMS(37, 7) PARMS(0, 0) = "Paràmetres" PARMS(0, 1) = IPPF_ANYREF For i1 = 1 To 22 If BENS_E(i1) = 1 Then PARMS(i1, 1) = "x" PARMS(i1, 2) = MINIMS_E(i1) Next i1 ElseIf MultiPage1.Value = 1 Then If Not IsNumeric(TextBox21.Value) Or (Val(TextBox21.Value) < 0) Then ERR_LEC = True Me.Hide MsgBox "Error en la reducció general per obligació personal.", vbCritical, TITOL_IPPF Exit Sub Else REDUCCIO(1) = Val(Replace(TextBox21.Value, ",", ".")) 'Reducció Obligació personal general End If If Not IsNumeric(TextBox22.Value) Or (Val(TextBox22.Value) < 0) Then ERR_LEC = True Me.Hide MsgBox "Error en la reducció per a discapacitats per obligació personal.", vbCritical, TITOL_IPPF Exit Sub Else REDUCCIO(2) = Val(Replace(TextBox22.Value, ",", ".")) 'Reducció Obligació personal discapcitats End If NTRAMS = Val(ListBox22.Value) 'Trams i tipus impositius ReDim TIPUS(1 To NTRAMS), T(1 To NTRAMS) For i1 = 1 To NTRAMS For Each CTL In Frame222.Controls If i1 <> NTRAMS Then If CTL.Name = "TextBox222" & i1 & "2" Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & ".", vbCritical, TITOL_IPPF Exit Sub Else T(i1) = Val(Replace(CTL.Value, ",", ".")) End If End If End If If CTL.Name = "TextBox222" & i1 & "3" Then If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu del TRAM " & i1 & ".", vbCritical, TITOL_IPPF Exit Sub Else TIPUS(i1) = Val(Replace(CTL.Value, ",", ".")) / 100 End If End If Next CTL If i1 <> 1 Then If i1 <> NTRAMS Then If T(i1) <= T(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & ".", vbCritical, TITOL_IPPF Exit Sub End If End If If TIPUS(i1) < TIPUS(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu del TRAM " & i1 & ".", vbCritical, TITOL_IPPF Exit Sub End If End If Next i1 ReDim LIMITS(1 To 2) 'Connexió IRPF If CheckBox23.Value Then CONNEXIO_IRPF = True LIMITS(1) = Val(ListBox231.Value) / 100 LIMITS(2) = Val(ListBox232.Value) / 100 Else CONNEXIO_IRPF = False End If PROJ(1) = 1 + (ListBox241.Value / 100) 'Coeficients de projecció PROJ(2) = 1 + (ListBox242.Value / 100) PROJ(3) = 1 + (ListBox243.Value / 100) ''''''''''''''''''''''''''''''''''''''' 'Guarda els paràmetres del segon quadre ''''''''''''''''''''''''''''''''''''''' PARMS(23, 1) = REDUCCIO(1) PARMS(23, 2) = REDUCCIO(2) PARMS(0, 2) = NTRAMS For i1 = 1 To NTRAMS If i1 = 1 Then PARMS(23 + i1, 1) = "0" PARMS(23 + i1, 2) = IIf(i1 <> NTRAMS, T(i1), "i més") PARMS(23 + i1, 3) = TIPUS(i1) + 0.0000000001 ElseIf i1 < NTRAMS Then PARMS(23 + i1, 1) = T(i1 - 1) PARMS(23 + i1, 2) = T(i1) PARMS(23 + i1, 3) = TIPUS(i1) + 0.0000000001 Else PARMS(23 + i1, 1) = T(i1 - 1) PARMS(23 + i1, 2) = "i més" PARMS(23 + i1, 3) = TIPUS(i1) + 0.0000000001 End If Next i1 PARMS(0, 3) = CONNEXIO_IRPF PARMS(36, 1) = LIMITS(1) + 0.0000000001 PARMS(36, 2) = LIMITS(2) + 0.0000000001 PARMS(37, 1) = PROJ(1) PARMS(37, 2) = PROJ(2) PARMS(37, 3) = PROJ(3) End If Unload Me End Sub Private Sub Anterior_Click() PAGINA = PAGINA - 1 MultiPage1.Value = PAGINA Me.Caption = "SIMCAT-IPPF: Determinació dels béns i drets exempts i dels mínims exempts (Base de dades: " & ANOIPPF & ")" NetejaValors.Value = False Llei.Value = False SimulRef.Value = False For Each CTL In Frame11.Controls If PARMS(CTL.TabIndex + 1, 1) = "x" Then CTL.Value = True Else CTL.Value = False Next CTL For Each CTL In Frame13.Controls CTL.Value = PARMS(CTL.TabIndex + 1, 2) Next CTL End Sub Private Sub Cancelar_Click() SORTIR = True IMPOST(5) = True Unload Me End Sub Private Sub CheckBox111_Click() If CheckBox111.Value Then Label121.Enabled = False Label141.Enabled = False TextBox131.Enabled = False TextBox131.Value = "0" Else Label121.Enabled = True Label141.Enabled = True TextBox131.Enabled = True TextBox131.Value = IPPF_ME(1) End If End Sub Private Sub CheckBox112_Click() If CheckBox112.Value Then Label122.Enabled = False Label142.Enabled = False TextBox132.Enabled = False TextBox132.Value = "0" Else Label122.Enabled = True Label142.Enabled = True TextBox132.Enabled = True TextBox132.Value = "0" End If End Sub Private Sub CheckBox113_Click() If CheckBox113.Value Then Label123.Enabled = False Label143.Enabled = False TextBox133.Enabled = False TextBox133.Value = "0" Else Label123.Enabled = True Label143.Enabled = True TextBox133.Enabled = True TextBox133.Value = "0" End If End Sub Private Sub CheckBox114_Click() If CheckBox114.Value Then Label124.Enabled = False Label144.Enabled = False TextBox134.Enabled = False TextBox134.Value = "0" Else Label124.Enabled = True Label144.Enabled = True TextBox134.Enabled = True TextBox134.Value = "0" End If End Sub Private Sub CheckBox115_Click() If CheckBox115.Value Then Label125.Enabled = False Label145.Enabled = False TextBox135.Enabled = False TextBox135.Value = "0" Else Label125.Enabled = True Label145.Enabled = True TextBox135.Enabled = True TextBox135.Value = "0" End If End Sub Private Sub CheckBox116_Click() If CheckBox116.Value Then Label126.Enabled = False Label146.Enabled = False TextBox136.Enabled = False TextBox136.Value = "0" Else Label126.Enabled = True Label146.Enabled = True TextBox136.Enabled = True TextBox136.Value = "0" End If End Sub Private Sub CheckBox117_Click() If CheckBox117.Value Then Label127.Enabled = False Label147.Enabled = False TextBox137.Enabled = False TextBox137.Value = "0" Else Label127.Enabled = True Label147.Enabled = True TextBox137.Enabled = True TextBox137.Value = "0" End If End Sub Private Sub CheckBox118_Click() If CheckBox118.Value Then Label128.Enabled = False Label148.Enabled = False TextBox138.Enabled = False TextBox138.Value = "0" Else Label128.Enabled = True Label148.Enabled = True TextBox138.Enabled = True TextBox138.Value = "0" End If End Sub Private Sub CheckBox119_Click() If CheckBox119.Value Then Label129.Enabled = False Label149.Enabled = False TextBox139.Enabled = False TextBox139.Value = "0" Else Label129.Enabled = True Label149.Enabled = True TextBox139.Enabled = True TextBox139.Value = "0" End If End Sub Private Sub CheckBox1110_Click() If CheckBox1110.Value Then Label1210.Enabled = False Label1410.Enabled = False TextBox1310.Enabled = False TextBox1310.Value = "0" Else Label1210.Enabled = True Label1410.Enabled = True TextBox1310.Enabled = True TextBox1310.Value = "0" End If End Sub Private Sub CheckBox1111_Click() If CheckBox1111.Value Then Label1211.Enabled = False Label1411.Enabled = False TextBox1311.Enabled = False TextBox1311.Value = "0" Else Label1211.Enabled = True Label1411.Enabled = True TextBox1311.Enabled = True TextBox1311.Value = "0" End If End Sub Private Sub CheckBox1112_Click() If CheckBox1112.Value Then Label1212.Enabled = False Label1412.Enabled = False TextBox1312.Enabled = False TextBox1312.Value = "0" Else Label1212.Enabled = True Label1412.Enabled = True TextBox1312.Enabled = True TextBox1312.Value = "0" End If End Sub Private Sub CheckBox1113_Click() If CheckBox1113.Value Then Label1213.Enabled = False Label1413.Enabled = False TextBox1313.Enabled = False TextBox1313.Value = "0" Else Label1213.Enabled = True Label1413.Enabled = True TextBox1313.Enabled = True TextBox1313.Value = "0" End If End Sub Private Sub CheckBox1114_Click() If CheckBox1114.Value Then Label1214.Enabled = False Label1414.Enabled = False TextBox1314.Enabled = False TextBox1314.Value = "0" Else Label1214.Enabled = True Label1414.Enabled = True TextBox1314.Enabled = True TextBox1314.Value = "0" End If End Sub Private Sub CheckBox1115_Click() If CheckBox1115.Value Then Label1215.Enabled = False Label1415.Enabled = False TextBox1315.Enabled = False TextBox1315.Value = "0" Else Label1215.Enabled = True Label1415.Enabled = True TextBox1315.Enabled = True TextBox1315.Value = "0" End If End Sub Private Sub CheckBox1116_Click() If CheckBox1116.Value Then Label1216.Enabled = False Label1416.Enabled = False TextBox1316.Enabled = False TextBox1316.Value = "0" Else Label1216.Enabled = True Label1416.Enabled = True TextBox1316.Enabled = True TextBox1316.Value = "0" End If End Sub Private Sub CheckBox1117_Click() If CheckBox1117.Value Then Label1217.Enabled = False Label1417.Enabled = False TextBox1317.Enabled = False TextBox1317.Value = "0" Else Label1217.Enabled = True Label1417.Enabled = True TextBox1317.Enabled = True TextBox1317.Value = "0" End If End Sub Private Sub CheckBox1118_Click() If CheckBox1118.Value Then Label1218.Enabled = False Label1418.Enabled = False TextBox1318.Enabled = False TextBox1318.Value = "0" Else Label1218.Enabled = True Label1418.Enabled = True TextBox1318.Enabled = True TextBox1318.Value = "0" End If End Sub Private Sub CheckBox1119_Click() If CheckBox1119.Value Then Label1219.Enabled = False Label1419.Enabled = False TextBox1319.Enabled = False TextBox1319.Value = "0" Else Label1219.Enabled = True Label1419.Enabled = True TextBox1319.Enabled = True TextBox1319.Value = "0" End If End Sub Private Sub CheckBox1120_Click() If CheckBox1120.Value Then Label1220.Enabled = False Label1420.Enabled = False TextBox1320.Enabled = False TextBox1320.Value = "0" Else Label1220.Enabled = True Label1420.Enabled = True TextBox1320.Enabled = True TextBox1320.Value = "0" End If End Sub Private Sub CheckBox1121_Click() If CheckBox1121.Value Then Label1221.Enabled = False Label1421.Enabled = False TextBox1321.Enabled = False TextBox1321.Value = "0" Else Label1221.Enabled = True Label1421.Enabled = True TextBox1321.Enabled = True TextBox1321.Value = "0" End If End Sub Private Sub CheckBox1122_Click() If CheckBox1122.Value Then Label1222.Enabled = False Label1422.Enabled = False TextBox1322.Enabled = False TextBox1322.Value = "0" Else Label1222.Enabled = True Label1422.Enabled = True TextBox1322.Enabled = True TextBox1322.Value = "0" End If End Sub Private Sub CheckBox23_Click() If CheckBox23.Value Then Frame23.Height = 75 Else Frame23.Height = 30 ListBox231.Selected(3) = True ListBox231.TopIndex = 3 ListBox232.Selected(1) = True ListBox232.TopIndex = 1 End If End Sub Private Sub ListBox22_Click() Dim i1 As Integer NTRAMS = Val(ListBox22.Value) For Each CTL In Frame221.Controls If CTL.TabIndex <= NTRAMS - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame222.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMS - 1 If CTL.TabIndex = 3 * i1 + 1 Or CTL.TabIndex = 3 * i1 + 2 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox222" & NTRAMS & "2" Then CTL.Enabled = False CTL.Value = "En endavant" End If Next CTL For Each CTL In Frame223.Controls If CTL.TabIndex <= NTRAMS - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL TextBox22211.Value = "0" End Sub Private Sub ListBox_Simulref_Click() Dim i1 As Integer, nsim As Integer, p(37, 9) For i1 = 0 To ISIMULS(5) - 1 If ListBox_SimulRef.Selected(i1) = True Then nsim = ListBox_SimulRef.Value Exit For End If Next i1 Call COMUNS_1REFERENCIA_SIMULS("IPPF", nsim, p) If MultiPage1.Value = 0 Then For Each CTL In Frame11.Controls If p(CTL.TabIndex + 1, 1) = "x" Then CTL.Value = True Else CTL.Value = False Next CTL For Each CTL In Frame13.Controls CTL.Value = p(CTL.TabIndex + 1, 2) Next CTL ElseIf MultiPage1.Value = 1 Then TextBox21.Value = p(23, 1) TextBox22.Value = p(23, 2) ListBox22.Selected(12 - p(0, 2)) = True For Each CTL In Frame222.Controls For i1 = 1 To p(0, 2) If i1 <> p(0, 2) And CTL.Name = "TextBox222" & i1 & "2" Then CTL.Text = Round(p(23 + i1, 2), 2) If CTL.Name = "TextBox222" & i1 & "3" Then CTL.Text = Format(p(23 + i1, 3) * 100, "#0.000") Next i1 Next CTL If p(0, 3) Then CheckBox23.Value = True ListBox231.Selected(9 - Int(p(36, 1) * 10)) = True ListBox232.Selected(9 - Int(p(36, 2) * 10)) = True Else CheckBox23.Value = False End If ListBox241.Selected(150 - ((p(37, 1) - 1) * 1000)) = True ListBox242.Selected(150 - ((p(37, 2) - 1) * 1000)) = True ListBox243.Selected(150 - ((p(37, 3) - 1) * 1000)) = True End If End Sub Private Sub Llei_Click() Dim i1 As Integer If MultiPage1.Value = 0 Then For Each CTL In Frame11.Controls If CTL.TabIndex = 3 Or CTL.TabIndex = 11 Or CTL.TabIndex = 12 Then CTL.Value = True Else CTL.Value = False End If Next CTL For Each CTL In Frame13.Controls CTL.Value = "0" Next CTL TextBox131.Value = IPPF_ME(1) ElseIf MultiPage1.Value = 1 Then TextBox21.Value = IPPF_OP(1) TextBox22.Value = IPPF_OP(2) ListBox22.Selected(12 - IPPF_NTRAMS) = True For Each CTL In Frame222.Controls For i1 = 1 To IPPF_NTRAMS If i1 <> IPPF_NTRAMS And CTL.Name = "TextBox222" & i1 & "2" Then CTL.Text = IPPF_TRAMS(i1) If CTL.Name = "TextBox222" & i1 & "3" Then CTL.Text = Format(IPPF_TIPUS(i1) * 100, "#0.000") Next i1 Next CTL CheckBox23.Value = True ListBox231.Selected(3) = True ListBox232.Selected(1) = True ListBox241.Selected(150) = True ListBox242.Selected(150) = True ListBox243.Selected(150) = True End If End Sub Private Sub MultiPage1_Layout(ByVal Index As Long) If MultiPage1.Value = 0 Then Aceptar.Left = 240 Anterior.Visible = False Cancelar.Left = 288 ElseIf MultiPage1.Value = 1 Then Aceptar.Left = 263 Anterior.Visible = True Cancelar.Left = 311 End If End Sub Private Sub NetejaValors_Click() If MultiPage1.Value = 0 Then For Each CTL In Frame11.Controls CTL.Value = False Next CTL For Each CTL In Frame13.Controls CTL.Value = "0" Next CTL ElseIf MultiPage1.Value = 1 Then TextBox21.Value = "0" TextBox22.Value = "0" ListBox22.Selected(11) = True TextBox22211.Value = "0" TextBox22212.Value = "En endavant" TextBox22213.Value = "1" CheckBox23.Value = False ListBox231.Selected(3) = True ListBox231.TopIndex = 3 ListBox232.Selected(1) = True ListBox232.TopIndex = 1 ListBox241.Selected(150) = True ListBox241.TopIndex = 150 ListBox242.Selected(150) = True ListBox242.TopIndex = 150 ListBox243.Selected(150) = True ListBox243.TopIndex = 150 End If End Sub Private Sub SimulRef_Change() Dim i1 As Integer If SimulRef Then Frame02.Width = 190 For i1 = 0 To ISIMULS(5) - 1 ListBox_SimulRef.Selected(i1) = False Next i1 Else Frame02.Width = 150 ListBox_SimulRef.TopIndex = 0 End If End Sub Private Sub Textbox22212_Change() If IsNumeric(TextBox22212.Value) Then TextBox22221.Value = TextBox22212.Value End Sub Private Sub Textbox22222_Change() If IsNumeric(TextBox22222.Value) Then TextBox22231.Value = TextBox22222.Value End Sub Private Sub Textbox22232_Change() If IsNumeric(TextBox22232.Value) Then TextBox22241.Value = TextBox22232.Value End Sub Private Sub Textbox22242_Change() If IsNumeric(TextBox22242.Value) Then TextBox22251.Value = TextBox22242.Value End Sub Private Sub Textbox22252_Change() If IsNumeric(TextBox22252.Value) Then TextBox22261.Value = TextBox22252.Value End Sub Private Sub TextBox22262_Change() If IsNumeric(TextBox22262.Value) Then TextBox22271.Value = TextBox22262.Value End Sub Private Sub TextBox22272_Change() If IsNumeric(TextBox22272.Value) Then TextBox22281.Value = TextBox22272.Value End Sub Private Sub TextBox22282_Change() If IsNumeric(TextBox22282.Value) Then TextBox22291.Value = TextBox22282.Value End Sub Private Sub TextBox22292_Change() If IsNumeric(TextBox22292.Value) Then TextBox222101.Value = TextBox22292.Value End Sub Private Sub TextBox222102_Change() If IsNumeric(TextBox222102.Value) Then TextBox222111.Value = TextBox222102.Value End Sub Private Sub TextBox222112_Change() If IsNumeric(TextBox222112.Value) Then TextBox222121.Value = TextBox222112.Value End Sub Private Sub UserForm_Activate() height1 = Me.Height left1 = Me.Left top1 = Me.Top width1 = Me.Width If ISIMULS(5) <> 0 Then Frame02.Width = 150 Else Frame02.Width = 104 End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then SORTIR = True Unload Me End Sub Private Sub UserForm_Zoom(Percent As Integer) Me.Width = Me.Width * Percent / 100 Me.Height = Me.Height * Percent / 100 Me.Left = left1 - ((Me.Width - width1) / 2) Me.Top = top1 - ((Me.Width - width1) / 2) End Sub VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} IRPF Caption = "IRPF" ClientHeight = 9432 ClientLeft = 48 ClientTop = 396 ClientWidth = 12924 OleObjectBlob = "IRPF.frx":0000 StartUpPosition = 1 'Centrar en propietario End Attribute VB_Name = "IRPF" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim height1 As Integer, left1 As Integer, top1 As Integer, width1 As Integer Private Sub Aceptar_Click() Dim i1 As Integer, i2 As Integer, j1 As Integer, c(1 To 2) As Controls ERR_LEC = False If MultiPage1.Value = 0 Then ' '''''''''''''''''''''''''''''''''''''''''''''''''' 'Guarda els paràmetres de les projeccions a PARMS' '''''''''''''''''''''''''''''''''''''''''''''''''' If TotsSi.Value Then DECL_NOMBRE = "TOTS" Else DECL_NOMBRE = "OBLIGATS" PARMS(0, 3) = DECL_NOMBRE PARMS(0, 4) = ANY_PROJ For j1 = 1 To 5 PARMS(0, j1 + 4) = PROJ(j1) Next j1 PARMS(0, 10) = IRPF_ANYREF C_BASE = 0 LIM_BASE = 0 If O_BI.Value Or O_BL.Value Then If Not IsNumeric(TextBox10.Value) Or Val(TextBox10.Value) <= 0 Then ERR_LEC = True Me.Hide If O_BI Then MsgBox "Error límite BIT para discriminar MPF y tarifa base general CANARIAS.", vbCritical, TITOL_IRPF If O_BL Then MsgBox "Error límite BLT para discriminar MPF y tarifa base general CANARIAS.", vbCritical, TITOL_IRPF Exit Sub Else LIM_BASE = Val(TextBox10.Value) End If If O_BI.Value Then C_BASE = 1 If O_BL.Value Then C_BASE = 2 End If ReDim MPF(11, 3) 'Mínims personals If CheckBox11.Value Then MPF(0, 0) = 1 For Each CTL In Frame1121.Controls For i1 = 1 To 13 If CTL.Name = "TextBox1121" & i1 Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error MPF " & i1 & " ESTADO.", vbCritical, TITOL_IRPF Exit Sub Else MPF(i1, 1) = Val(CTL.Value) End If End If Next i1 Next CTL For Each CTL In Frame1122.Controls For i1 = 1 To 11 If CTL.Name = "TextBox1122" & i1 Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) < 0 Then ERR_LEC = True Me.Hide If Not CheckBox10 Then MsgBox "Error MPF " & i1 & " CANARIAS", vbCritical, TITOL_IRPF If CheckBox10 Then MsgBox "Error MPF " & i1 & " CANARIAS " & IIf(O_BI, "(BIT", "(BLT") & " < " & LIM_BASE & ").", vbCritical, TITOL_IRPF End If Exit Sub Else MPF(i1, 2) = Val(CTL.Value) End If End If Next i1 Next CTL For i1 = 1 To 11 If MPF(i1, 1) <> 0 And MPF(i1, 2) <> 0 Then If MPF(i1, 1) / MPF(i1, 2) > 1.2 Or MPF(i1, 1) / MPF(i1, 2) < 0.8 Then ERR_LEC = True Me.Hide If Not CheckBox10 Then MsgBox "El MPF CANARIAS " & i1 & " no puede ser superior ni inferior al 20% del ESTADO.", vbCritical, TITOL_IRPF If CheckBox10 Then MsgBox "El MPF " & i1 & " CANARIAS " & IIf(O_BI, "(BIT", "(BLT") & " < " & LIM_BASE & ") no puede ser superior ni inferior al 20% del ESTADO.", vbCritical, TITOL_IRPF End If Exit Sub End If End If Next i1 If CheckBox10 Then For Each CTL In Frame1123.Controls For i1 = 1 To 11 If CTL.Name = "TextBox1123" & i1 Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error MPF " & i1 & " CANARIAS" & IIf(O_BI, "(BIT", "(BLT") & " >= " & LIM_BASE & ").", vbCritical, TITOL_IRPF Exit Sub Else MPF(i1, 3) = Val(CTL.Value) End If End If Next i1 Next CTL For i1 = 1 To 11 If MPF(i1, 1) <> 0 And MPF(i1, 3) <> 0 Then If MPF(i1, 1) / MPF(i1, 3) > 1.2 Or MPF(i1, 1) / MPF(i1, 3) < 0.8 Then ERR_LEC = True Me.Hide MsgBox "El MPF " & i1 & " CANARIAS " & IIf(O_BI, "(BIT", "(BLT") & " >= " & LIM_BASE & ") no puede ser superior ni inferior al 20% del ESTADO.", vbCritical, TITOL_IRPF Exit Sub End If End If Next i1 End If End If ReDim RTC(2) 'Tributació conjunta If CheckBox12.Value Then RTC(0) = 1 If Not IsNumeric(TextBox121.Value) Or Val(TextBox121.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la reducción per tributación conjunta (matrimonio o pareja de hecho)", vbCritical, TITOL_IRPF Exit Sub Else RTC(1) = Val(TextBox121.Value) End If If Not IsNumeric(TextBox122.Value) Or Val(TextBox122.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la reducción por tributación conjunta (separación legal)", vbCritical, TITOL_IRPF Exit Sub Else RTC(2) = Val(TextBox122.Value) End If End If ReDim DDRT(4) 'Despeses deduïbles Rendiments Treball If CheckBox13.Value Then DDRT(0) = 1 If (Not IsNumeric(TextBox131.Value) Or Val(TextBox131.Value) < 0) Or _ (Not IsNumeric(TextBox132.Value) Or Val(TextBox132.Value) < 0) Or _ (Not IsNumeric(TextBox133.Value) Or Val(TextBox133.Value) < 0) Or _ (Not IsNumeric(TextBox134.Value) Or Val(TextBox134.Value) < 0) Then ERR_LEC = True Me.Hide MsgBox "Algún importe de los gastos deducibles de los rendimientos del trabajo es incorrecto.", vbCritical, TITOL_IRPF Exit Sub Else DDRT(1) = Val(TextBox131.Value) DDRT(2) = Val(TextBox132.Value) DDRT(3) = Val(TextBox133.Value) DDRT(4) = Val(TextBox134.Value) End If End If ReDim RT(2, 4) 'Reduccions Rendiments Treball If CheckBox14.Value Then RT(0, 0) = 1 If (Not IsNumeric(TextBox1412.Value) Or Val(TextBox1412.Value) < 0) Or _ (Not IsNumeric(TextBox1413.Value) Or Val(TextBox1413.Value) < 0) Or _ (Not IsNumeric(TextBox1422.Value) Or Val(TextBox1422.Value) < 0) Or _ (Not IsNumeric(TextBox1423.Value) Or Val(TextBox1423.Value) < 0) Then ERR_LEC = True Me.Hide MsgBox "Algún importe de la reducción por percepción del trabajo personal es incorrecto.", vbCritical, TITOL_IRPF Exit Sub Else If Val(TextBox1412.Value) > Val(TextBox1422.Value) Then ERR_LEC = True Me.Hide MsgBox "En la reducción por percepción del trabajo personal, el límite máximo del primer tramo " & _ "no puede ser superior al límite máxim del segundo tramo.", vbCritical, TITOL_IRPF Exit Sub End If If Val(TextBox1413.Value) < Val(TextBox1423.Value) Then ERR_LEC = True Me.Hide MsgBox "En la reducción por percepción del trabajo personal, la reducción del segundo tramo " & _ "no puede ser superior a la del primer tramo.", vbCritical, TITOL_IRPF Exit Sub End If RT(1, 2) = Val(TextBox1412.Value) RT(1, 3) = Val(TextBox1413.Value) RT(2, 2) = Val(TextBox1422.Value) RT(2, 3) = Val(TextBox1423.Value) End If TextBox1424.Value = Replace(TextBox1424.Value, ",", ".") If (Not IsNumeric(TextBox1424.Value) Or Val(TextBox1424.Value) < 0 Or Val(TextBox1424.Value) > 2) Then ERR_LEC = True Me.Hide MsgBox "Error en el corrector de la reducción por percepción del trabajo personal " & _ "no puede ser negativo ni superior a 2.", vbCritical, TITOL_IRPF Exit Sub End If RT(2, 4) = Val(TextBox1424.Value) End If ReDim RPP(4) 'Reduccions Plans Pensions If CheckBox15.Value Then RPP(0) = 1 If (Not IsNumeric(TextBox151.Value) Or Val(TextBox151.Value) < 0) Or _ (Not IsNumeric(TextBox152.Value) Or Val(TextBox152.Value) < 0) Or _ (Not IsNumeric(TextBox153.Value) Or Val(TextBox153.Value) < 0) Or _ (Not IsNumeric(TextBox154.Value) Or Val(TextBox154.Value) < 0) Then ERR_LEC = True Me.Hide MsgBox "Error en la reducción por planes de previsión.", vbCritical, TITOL_IRPF Exit Sub Else RPP(1) = Val(TextBox151.Value) RPP(2) = Val(TextBox152.Value) RPP(3) = Val(TextBox153.Value) RPP(4) = Val(TextBox154.Value) End If If RPP(1) > IRPF_RED_PP(1) Then ERR_LEC = True Me.Hide MsgBox "En las aportaciones a planes de previsión, el límite general " & _ "no puede ser superior a " & IRPF_RED_PP(1) & ".", vbCritical, TITOL_IRPF Exit Sub End If If RPP(2) > IRPF_RED_PP(2) Then ERR_LEC = True Me.Hide MsgBox "En las aportaciones a planes de previsión, el límite para cónyuge no puede ser superior a " & _ IRPF_RED_PP(2) & ".", vbCritical, TITOL_IRPF Exit Sub End If If RPP(3) > IRPF_RED_PP(3) Then ERR_LEC = True Me.Hide MsgBox "En las aportaciones a planes de previsión, el límite para discapacitados no puede ser superior a " & _ IRPF_RED_PP(3) & ".", vbCritical, TITOL_IRPF Exit Sub End If If RPP(4) > IRPF_RED_PP(4) Then ERR_LEC = True Me.Hide MsgBox "En las aportaciones a planes de previsión, el límite para deportistas profesionales " & _ "no puede ser superior a " & IRPF_RED_PP(4) & ".", vbCritical, TITOL_IRPF Exit Sub End If End If ''''''''''''''''''''''''''''''''''''''''''''''''' 'Guarda els paràmetres del primer quadre a PARMS' ''''''''''''''''''''''''''''''''''''''''''''''''' PARMS(0, 11) = C_BASE PARMS(0, 12) = LIM_BASE PARMS(0, 13) = MPF(0, 0) If MPF(0, 0) = 1 Then For i1 = 1 To 11 PARMS(1, i1) = MPF(i1, 1) PARMS(2, i1) = MPF(i1, 2) PARMS(3, i1) = MPF(i1, 3) Next i1 End If PARMS(0, 14) = RTC(0) If RTC(0) = 1 Then PARMS(4, 1) = RTC(1) PARMS(4, 2) = RTC(2) End If PARMS(0, 15) = DDRT(0) If DDRT(0) = 1 Then PARMS(5, 1) = DDRT(1) PARMS(5, 2) = DDRT(2) PARMS(5, 3) = DDRT(3) PARMS(5, 4) = DDRT(4) End If PARMS(0, 16) = RT(0, 0) If RT(0, 0) = 1 Then PARMS(6, 1) = "0" PARMS(6, 2) = RT(1, 2) PARMS(6, 3) = RT(1, 3) PARMS(7, 1) = RT(1, 2) PARMS(7, 2) = RT(2, 2) PARMS(7, 3) = RT(2, 3) PARMS(7, 4) = RT(2, 4) End If PARMS(0, 17) = RPP(0) If RPP(0) = 1 Then PARMS(8, 1) = RPP(1) PARMS(8, 2) = RPP(2) PARMS(8, 3) = RPP(3) PARMS(8, 4) = RPP(4) End If ElseIf MultiPage1.Value = 1 Then 'Tarifa General ESTAT i Tarifa Estalvi ReDim NTRAMSG(1 To 3), TG(1 To 10, 1 To 3), TIPUSG(1 To 10, 1 To 3) NTRAMSG(1) = ListBox21.Value 'Trams i tipus base general ESTAT For i1 = 1 To NTRAMSG(1) For Each CTL In Frame212.Controls If i1 <> NTRAMSG(1) Then If CTL.Name = "TextBox212" & i1 & "2" Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error TRAMO " & i1 & " base general ESTADO.", vbCritical, TITOL_IRPF Exit Sub Else TG(i1, 1) = Val(Replace(CTL.Value, ",", ".")) End If End If End If If CTL.Name = "TextBox212" & i1 & "3" Then CTL.Value = Replace(CTL.Value, ",", ".") If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error tipo impositivo TRAMO " & i1 & " base general ESTADO.", vbCritical, TITOL_IRPF Exit Sub Else TIPUSG(i1, 1) = Val(CTL.Value) / 100 End If End If Next CTL If i1 > 1 Then If i1 <> NTRAMSG(1) Then If TG(i1, 1) <= TG(i1 - 1, 1) Then ERR_LEC = True Me.Hide MsgBox "Error TRAMO " & i1 & " base general ESTADO.", vbCritical, TITOL_IRPF Exit Sub End If End If If TIPUSG(i1, 1) < TIPUSG(i1 - 1, 1) Then ERR_LEC = True Me.Hide MsgBox "Error tipo impositivo TRAMO " & i1 & " base general ESTADO.", vbCritical, TITOL_IRPF Exit Sub End If End If Next i1 Set c(1) = Frame2212.Controls Set c(2) = Frame2222.Controls NTRAMSG(2) = ListBox221.Value If LIM_BASE <> 0 Then NTRAMSG(3) = ListBox222.Value Else NTRAMSG(3) = NTRAMSG(2) For i1 = 1 To IIf(LIM_BASE = 0, 1, 2) For i2 = 1 To NTRAMSG(i1 + 1) For Each CTL In c(i1) If i2 <> NTRAMSG(i1 + 1) Then If CTL.Name = "TextBox22" & i1 & "2" & i2 & "2" Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAMO " & i2 & " base general CANARIAS con BIT(" & i1 & ").", vbCritical, TITOL_IRPF Exit Sub Else TG(i2, i1 + 1) = Val(Replace(CTL.Value, ",", ".")) End If End If End If If CTL.Name = "TextBox22" & i1 & "2" & i2 & "3" Then CTL.Value = Replace(CTL.Value, ",", ".") If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error tipo impositivo TRAMO " & i2 & " base general CANARIAS con BIT(" & i1 & ").", vbCritical, TITOL_IRPF Exit Sub Else TIPUSG(i2, i1 + 1) = Val(CTL.Value) / 100 End If End If Next CTL If i2 <> 1 Then If i2 <> NTRAMSG(i1 + 1) Then If TG(i2, i1 + 1) <= TG(i2 - 1, i1 + 1) Then ERR_LEC = True Me.Hide MsgBox "Error TRAMO " & i2 & " base general CANARIAS con BIT(" & i1 & ").", vbCritical, TITOL_IRPF Exit Sub End If End If If TIPUSG(i2, i1 + 1) < TIPUSG(i2 - 1, i1 + 1) Then ERR_LEC = True Me.Hide MsgBox "Error tipo impositivo TRAMO " & i2 & " base general CANARIAS con BIT(" & i1 & ").", vbCritical, TITOL_IRPF Exit Sub End If End If Next i2 Next i1 NTRAMSE = ListBox23.Value ReDim TIPUSE(1 To NTRAMSE, 1 To 2), TE(1 To NTRAMSE, 1 To 2) 'Trams i tipus base estalvi For i1 = 1 To NTRAMSE For Each CTL In Frame232.Controls If i1 <> NTRAMSE Then If CTL.Name = "TextBox232" & i1 & "2" Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error TRAMO " & i1 & " base del ahorro.", vbCritical, TITOL_IRPF Exit Sub Else TE(i1, 1) = Val(Replace(CTL.Value, ",", ".")) End If End If End If For i2 = 1 To 2 If CTL.Name = "TextBox232" & i1 & IIf(i2 = 1, 3, 4) Then CTL.Value = Replace(CTL.Value, ",", ".") If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error tipo impositivo " & IIf(i2 = 1, "ESTADO", "CANARIAS") & " TRAM " & i1 & " base ahorro.", vbCritical, TITOL_IRPF Exit Sub Else TIPUSE(i1, i2) = Val(CTL.Value) / 100 End If End If Next i2 Next CTL If i1 <> 1 Then If i1 <> NTRAMSE Then If TE(i1, 1) <= TE(i1 - 1, 1) Then ERR_LEC = True Me.Hide MsgBox "Error TRAMO " & i1 & " base del ahorro.", vbCritical, TITOL_IRPF Exit Sub End If End If For i2 = 1 To 2 If TIPUSE(i1, i2) < TIPUSE(i1 - 1, i2) Then ERR_LEC = True Me.Hide MsgBox "Error Error tipo impositivo " & IIf(i2 = 1, "ESTADO", "CANARIAS") & " TRAM " & i1 & " base ahorro.", vbCritical, TITOL_IRPF Exit Sub End If Next i2 End If TE(i1, 2) = TE(i1, 1) Next i1 If Not IsNumeric(TextBox23.Value) Or (Val(TextBox23.Value) < 0 Or Val(TextBox23.Value) > 6000) Then ERR_LEC = True Me.Hide MsgBox "Error mínimo exento base del ahorro: debe ser positivo e inferior a 6.000 €.", vbCritical, TITOL_IRPF Exit Sub Else MINIM_EXEMPTE = Val(TextBox23.Value) End If '''''''''''''''''''''''''''''''''''''''''''''''' 'Guarda els paràmetres del segon quadre a PARMS' '''''''''''''''''''''''''''''''''''''''''''''''' PARMS(0, 18) = NTRAMSG(1) For i1 = 1 To NTRAMSG(1) If i1 = 1 Then PARMS(8 + i1, 1) = "0" PARMS(8 + i1, 2) = IIf(i1 <> NTRAMSG(1), TG(i1, 1), "y más") PARMS(8 + i1, 3) = TIPUSG(i1, 1) ElseIf i1 < NTRAMSG(1) Then PARMS(8 + i1, 1) = TG(i1 - 1, 1) PARMS(8 + i1, 2) = TG(i1, 1) PARMS(8 + i1, 3) = TIPUSG(i1, 1) Else PARMS(8 + i1, 1) = TG(i1 - 1, 1) PARMS(8 + i1, 2) = "y más" PARMS(8 + i1, 3) = TIPUSG(i1, 1) End If Next i1 PARMS(0, 19) = NTRAMSG(2) For i1 = 1 To NTRAMSG(2) If i1 = 1 Then PARMS(8 + i1, 4) = "0" PARMS(8 + i1, 5) = IIf(i1 <> NTRAMSG(2), TG(i1, 2), "y más") PARMS(8 + i1, 6) = TIPUSG(i1, 2) ElseIf i1 < NTRAMSG(2) Then PARMS(8 + i1, 4) = TG(i1 - 1, 2) PARMS(8 + i1, 5) = TG(i1, 2) PARMS(8 + i1, 6) = TIPUSG(i1, 2) Else PARMS(8 + i1, 4) = TG(i1 - 1, 2) PARMS(8 + i1, 5) = "y más" PARMS(8 + i1, 6) = TIPUSG(i1, 2) End If Next i1 If LIM_BASE <> 0 Then PARMS(0, 20) = NTRAMSG(3) For i1 = 1 To NTRAMSG(3) If i1 = 1 Then PARMS(8 + i1, 7) = "0" PARMS(8 + i1, 8) = IIf(i1 <> NTRAMSG(3), TG(i1, 3), "y más") PARMS(8 + i1, 9) = TIPUSG(i1, 3) ElseIf i1 < NTRAMSG(3) Then PARMS(8 + i1, 7) = TG(i1 - 1, 3) PARMS(8 + i1, 8) = TG(i1, 3) PARMS(8 + i1, 9) = TIPUSG(i1, 3) Else PARMS(8 + i1, 7) = TG(i1 - 1, 3) PARMS(8 + i1, 8) = "y más" PARMS(8 + i1, 9) = TIPUSG(i1, 3) End If Next i1 End If PARMS(0, 21) = NTRAMSE For i1 = 1 To NTRAMSE If i1 = 1 Then PARMS(8 + i1, 10) = "0" PARMS(8 + i1, 11) = IIf(i1 <> NTRAMSE, TE(i1, 1), "y más") PARMS(8 + i1, 12) = TIPUSE(i1, 1) PARMS(8 + i1, 13) = TIPUSE(i1, 2) ElseIf i1 < NTRAMSE Then PARMS(8 + i1, 10) = TE(i1 - 1, 1) PARMS(8 + i1, 11) = TE(i1, 1) PARMS(8 + i1, 12) = TIPUSE(i1, 1) PARMS(8 + i1, 13) = TIPUSE(i1, 2) Else PARMS(8 + i1, 10) = TE(i1 - 1, 1) PARMS(8 + i1, 11) = "y más" PARMS(8 + i1, 12) = TIPUSE(i1, 1) PARMS(8 + i1, 13) = TIPUSE(i1, 2) End If Next i1 PARMS(8, 14) = MINIM_EXEMPTE ElseIf MultiPage1.Value = 2 Then 'Deduccions autonòmiques NDEDA = 0 If CheckBox3.Value Then NDEDA = UBound(IRPF_DA, 1) ReDim DEDA(NDEDA, 7) 'Deduccions autonòmiques ja contemplades DEDA(1, 1) = ListBox31.Value / 100 'Donaciones con finalidad ecológica If Not IsNumeric(TextBox31.Value) Or Val(TextBox31.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Donaciones con finalidad ecológica.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(1, 2) = Val(TextBox31.Value) End If DEDA(2, 1) = ListBox32.Value / 100 'Donaciones para la rehabilitación o conservación del patrimonio histórico de Canarias If Not IsNumeric(TextBox32.Value) Or Val(TextBox32.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Donaciones para la rehabilitación o conservación del patrimonio histórico de Canarias.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(2, 2) = Val(TextBox32.Value) End If DEDA(3, 1) = ListBox33.Value / 100 'Cantidades destinadas por sus titulares a la restauración, rehabilitación o reparación de bienes inmuebles declarados de Interés Cultural If Not IsNumeric(TextBox341.Value) Or Val(TextBox341.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Gastos de estudios (general).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(4, 1) = Val(TextBox341.Value) 'Gastos de estudios (general) End If If Not IsNumeric(TextBox342.Value) Or Val(TextBox342.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Gastos de estudios (BL inferior a 33.070 euros).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(4, 2) = Val(TextBox342.Value) 'Gastos de estudios (BL inferior a 33.070 euros) End If If Not IsNumeric(TextBox35.Value) Or Val(TextBox35.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Traslado residencia habitual a otra isla del Archipiélago para realizar una actividad laboral por cuenta ajena o una actividad económica.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(5, 1) = Val(TextBox35.Value) 'Traslado residencia habitual a otra isla del Archipiélago para realizar una actividad laboral por cuenta ajena o una actividad económica End If DEDA(6, 1) = ListBox361.Value / 100 'Por donaciones en metálico a descendientes o adoptados menores de 35 años para la adquisición o rehabilitación de su primera vivienda habitual DEDA(6, 3) = ListBox362.Value / 100 DEDA(6, 5) = ListBox363.Value / 100 If Not IsNumeric(TextBox361.Value) Or Val(TextBox361.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: 'Por donaciones en metálico a descendientes o adoptados menores de 35 años para la adquisición o rehabilitación de su primera vivienda habitual (general).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(6, 2) = Val(TextBox361.Value) 'Por donaciones en metálico a descendientes o adoptados menores de 35 años para la adquisición o rehabilitación de su primera vivienda habitual (general) End If If Not IsNumeric(TextBox362.Value) Or Val(TextBox362.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Por donaciones en metálico a descendientes o adoptados menores de 35 años para la adquisición o rehabilitación de su primera vivienda habitual (discapacitados 33%-65%).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(6, 4) = Val(TextBox362.Value) 'Por donaciones en metálico a descendientes o adoptados menores de 35 años para la adquisición o rehabilitación de su primera vivienda habitual (discapacitados 33%-65%) End If If Not IsNumeric(TextBox363.Value) Or Val(TextBox363.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Por donaciones en metálico a descendientes o adoptados menores de 35 años para la adquisición o rehabilitación de su primera vivienda habitual (discapacitados >65%).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(6, 6) = Val(TextBox363.Value) 'Por donaciones en metálico a descendientes o adoptados menores de 35 años para la adquisición o rehabilitación de su primera vivienda habitual (discapacitados >65%) End If If Not IsNumeric(TextBox371.Value) Or Val(TextBox371.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Nacimiento o adopción de hijos (1º o 2º).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(7, 1) = Val(TextBox371.Value) 'Nacimiento o adopción de hijos (1º o 2º) End If If Not IsNumeric(TextBox372.Value) Or Val(TextBox372.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Nacimiento o adopción de hijos (3º).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(7, 2) = Val(TextBox372.Value) 'Nacimiento o adopción de hijos (3º) End If If Not IsNumeric(TextBox373.Value) Or Val(TextBox373.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Nacimiento o adopción de hijos (4º).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(7, 3) = Val(TextBox373.Value) 'Nacimiento o adopción de hijos (4º) End If If Not IsNumeric(TextBox374.Value) Or Val(TextBox374.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Nacimiento o adopción de hijos (5º).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(7, 4) = Val(TextBox374.Value) 'Nacimiento o adopción de hijos (5º) End If If Not IsNumeric(TextBox375.Value) Or Val(TextBox375.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Nacimiento o adopción de hijos (1º o 2º discapacitado).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(7, 5) = Val(TextBox375.Value) 'Nacimiento o adopción de hijos (1º o 2º discapacitado) End If If Not IsNumeric(TextBox376.Value) Or Val(TextBox376.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Nacimiento o adopción de hijos (3º o 4º discapacitado).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(7, 6) = Val(TextBox376.Value) 'Nacimiento o adopción de hijos (3º o 4º discapacitado) End If If Not IsNumeric(TextBox381.Value) Or Val(TextBox381.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Contribuyentes discapacitados >33%.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(8, 1) = Val(TextBox381.Value) 'Contribuyentes discapacitados y/o mayores de 65 años End If If Not IsNumeric(TextBox382.Value) Or Val(TextBox382.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Contribuyentes mayores de 65 años.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(8, 2) = Val(TextBox382.Value) 'Contribuyentes discapacitados y/o mayores de 65 años End If DEDA(9, 1) = ListBox39.Value / 100 'Por gastos de guardería If Not IsNumeric(TextBox39.Value) Or Val(TextBox39.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Gastos de guardería", vbCritical, TITOL_IRPF Exit Sub Else DEDA(9, 2) = Val(TextBox39.Value) 'Gastos de guardería End If If Not IsNumeric(TextBox3101.Value) Or Val(TextBox3101.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Familia numerosa (general).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(10, 1) = Val(TextBox3101.Value) 'Familia numerosa (general) End If If Not IsNumeric(TextBox3102.Value) Or Val(TextBox3102.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Familia numerosa (especial).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(10, 2) = Val(TextBox3102.Value) 'Familia numerosa (especial) End If If Not IsNumeric(TextBox3103.Value) Or Val(TextBox3103.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Familia numerosa (general con discapacitados).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(10, 3) = Val(TextBox3103.Value) 'Familia numerosa (general con discapacitados) End If If Not IsNumeric(TextBox3104.Value) Or Val(TextBox3104.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Familia numerosa (especial con discapacitados).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(10, 4) = Val(TextBox3104.Value) 'Familia numerosa (especial con discapacitados) End If DEDA(11, 1) = ListBox3111.Value / 100 'Por inversión en vivienda habitual DEDA(11, 2) = ListBox3112.Value / 100 DEDA(12, 1) = ListBox312.Value / 100 'Por obras de adecuación de la vivienda habitual por razón de discapacidad DEDA(13, 1) = ListBox313.Value / 100 'Por alquiler de vivienda habitual If Not IsNumeric(TextBox313.Value) Or Val(TextBox313.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Alquiler vivienda habitual.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(13, 2) = Val(TextBox313.Value) 'Alquiler vivienda habitual End If If Not IsNumeric(TextBox314.Value) Or Val(TextBox314.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Contibuyentes desempleados.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(14, 1) = Val(TextBox314.Value) 'Contibuyentes desempleados End If DEDA(15, 1) = ListBox3151.Value / 100 'Por donaciones y aportaciones para fines culturales, deportivos, investigación o docencia DEDA(15, 2) = ListBox3152.Value / 100 DEDA(16, 1) = ListBox3161.Value / 100 'Por donaciones a entidades sin ánimo de lucro y con finalidad ecológica DEDA(16, 2) = ListBox3162.Value / 100 DEDA(16, 3) = ListBox3163.Value / 100 If Not IsNumeric(TextBox317.Value) Or Val(TextBox317.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Gastos de estudios en educación infantil y primaria, ESO, Bachillerato y FP grado medio.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(17, 1) = Val(TextBox317.Value) 'Gastos de estudios en educación infantil y primaria, ESO, Bachillerato y FP gr. medio End If If Not IsNumeric(TextBox318.Value) Or Val(TextBox318.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Acogimiento de menores.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(18, 1) = Val(TextBox318.Value) 'Acogimiento de menores End If If Not IsNumeric(TextBox319.Value) Or Val(TextBox319.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Familias monoparentales.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(19, 1) = Val(TextBox319.Value) 'Familias monoparentales End If DEDA(20, 1) = ListBox320.Value / 100 'Por obras de rehabilitación energética y reforma de la vivienda habitual If Not IsNumeric(TextBox320.Value) Or Val(TextBox320.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Obras de rehabilitación energética y reforma de la vivienda habitual.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(20, 2) = Val(TextBox320.Value) 'Obras de rehabilitación energética y reforma de la vivienda habitual End If DEDA(21, 1) = ListBox321.Value / 100 'Por gasto de enfermedad If Not IsNumeric(TextBox3211.Value) Or Val(TextBox3211.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Gastos de enfermedad (declaración conjunta).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(21, 2) = Val(TextBox3211.Value) 'Gastos de enfermedad (declaración conjunta) End If If Not IsNumeric(TextBox3212.Value) Or Val(TextBox3212.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Gastos de enfermedad (declaración individual).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(21, 3) = Val(TextBox3212.Value) 'Gastos de enfermedad (declaración individual) End If If Not IsNumeric(TextBox3213.Value) Or Val(TextBox3213.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Gastos de enfermedad (declaración individual con incremento por discapacitados > 65%).", vbCritical, TITOL_IRPF Exit Sub Else DEDA(21, 4) = Val(TextBox3213.Value) 'Gastos de enfermedad (declaración individual con incremento por discapacitados > 65%) End If If Not IsNumeric(TextBox322.Value) Or Val(TextBox322.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la deducción: Familiares dependientes con discapacidad.", vbCritical, TITOL_IRPF Exit Sub Else DEDA(22, 1) = Val(TextBox322.Value) 'Familiares dependientes con discapacidad End If End If '''''''''''''''''''''''''''''''''''''''''''''''' 'Guarda els paràmetres del tercer quadre a PARMS' '''''''''''''''''''''''''''''''''''''''''''''''' PARMS(0, 22) = NDEDA If NDEDA <> 0 Then For i1 = 1 To NDEDA For j1 = 1 To 6 PARMS(18 + i1, j1) = DEDA(i1, j1) Next j1 PARMS(18 + i1, 7) = "p-" & IIf(i1 < 14, 835 + i1, 839 + i1) Next i1 End If End If Unload Me End Sub Private Sub Anterior_Click() Dim i1 As Integer PAGINA = PAGINA - 1 MultiPage1.Value = PAGINA NetejaValors.Value = False SimulRef.Value = False If MultiPage1.Value = 0 Then Me.Caption = "SIMCAN-IRPF: Mínimos Personales y Familiares y Reducciones" & " (Base de datos: " & ANOIRPF & ")" If PARMS(0, 3) = "TOTS" Then TotsSi.Value = True Else TotsNo.Value = True ListBox_Proj.Selected(LBound(A_PROJ)) = True For i1 = 0 To UBound(A_PROJ) If PARMS(0, 4) = A_PROJ(i1) Then ListBox_Proj.Selected(i1) = True Exit For End If Next i1 If PARMS(0, 11) >= 1 Then CheckBox10.Value = True 'C_BASE If PARMS(0, 11) = 1 Then O_BI.Value = True If PARMS(0, 11) = 2 Then O_BL.Value = True TextBox10.Value = PARMS(0, 12) 'Límit BASE Else CheckBox10.Value = False End If If PARMS(0, 13) = 1 Then CheckBox11.Value = True Else CheckBox11.Value = False 'MPF For i1 = 1 To 11 For Each CTL In Frame1121.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = PARMS(1, i1) 'MPF ESTAT Next CTL For Each CTL In Frame1122.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = PARMS(2, i1) 'MPF CATALUNYA (BIT < LIM_BIT) Next CTL Next i1 If LIM_BASE <> 0 Then For i1 = 1 To 11 For Each CTL In Frame1123.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = PARMS(3, i1) 'MPF CATALUNYA (BIT >= LIM_BIT) Next CTL Next i1 End If If PARMS(0, 14) = 1 Then CheckBox12.Value = True Else CheckBox12.Value = False 'Tributació conjunta TextBox121.Value = PARMS(4, 1) TextBox122.Value = PARMS(4, 2) If PARMS(0, 15) = 1 Then CheckBox13.Value = True Else CheckBox13.Value = False 'Despeses deduïbles Rendiments Treball TextBox131.Value = PARMS(5, 1) TextBox132.Value = PARMS(5, 2) TextBox133.Value = PARMS(5, 3) TextBox134.Value = PARMS(5, 4) If PARMS(0, 16) = 1 Then CheckBox14.Value = True Else CheckBox14.Value = False 'Reducció rendiments Treball TextBox1412.Value = PARMS(6, 2) TextBox1413.Value = PARMS(6, 3) TextBox1422.Value = PARMS(7, 2) TextBox1423.Value = PARMS(7, 3) TextBox1424.Value = PARMS(7, 4) If PARMS(0, 17) = 1 Then CheckBox15.Value = True Else CheckBox15.Value = False 'Reducció Plans Pensions TextBox151.Value = PARMS(8, 1) TextBox152.Value = PARMS(8, 2) TextBox153.Value = PARMS(8, 3) TextBox154.Value = PARMS(8, 4) ElseIf MultiPage1.Value = 1 Then Me.Caption = "SIMCAN-IRPF: Tarifas Base General y del ahorro (ESTADO y CANARIAS)" & " (Base de datos: " & ANOIRPF & ")" ListBox21.Selected(10 - PARMS(0, 18)) = True 'Trams Base General ESTAT For Each CTL In Frame212.Controls For i1 = 1 To PARMS(0, 18) 'Tarifa Base General ESTAT If i1 <> PARMS(0, 18) And CTL.Name = "TextBox212" & i1 & "2" Then CTL.Text = PARMS(8 + i1, 2) If CTL.Name = "TextBox212" & i1 & "3" Then CTL.Text = Format(PARMS(8 + i1, 3) * 100, "#0.00") Next i1 Next CTL ListBox221.Selected(10 - PARMS(0, 19)) = True 'Trams Base General CANARIAS (BIT < LIMIT_BIT) For Each CTL In Frame2212.Controls For i1 = 1 To PARMS(0, 19) 'Tarifa Base General CANARIAS (BIT < LIMIT_BIT) If i1 <> PARMS(0, 19) And CTL.Name = "TextBox2212" & i1 & "2" Then CTL.Text = PARMS(8 + i1, 5) If CTL.Name = "TextBox2212" & i1 & "3" Then CTL.Text = Format(PARMS(8 + i1, 6) * 100, "#0.00") Next i1 Next CTL If LIM_BASE <> 0 Then ListBox222.Selected(10 - PARMS(0, 20)) = True 'Trams Base General CANARIAS (BIT >= LIMIT_BIT) For Each CTL In Frame2222.Controls For i1 = 1 To PARMS(0, 20) 'Tarifa Base General CANARIAS (BIT >= LIMIT_BIT) If i1 <> PARMS(0, 20) And CTL.Name = "TextBox2222" & i1 & "2" Then CTL.Text = PARMS(8 + i1, 8) If CTL.Name = "TextBox2222" & i1 & "3" Then CTL.Text = Format(PARMS(8 + i1, 9) * 100, "#0.00") Next i1 Next CTL End If ListBox23.Selected(10 - PARMS(0, 21)) = True 'Trams Base Estalvi For Each CTL In Frame232.Controls For i1 = 1 To PARMS(0, 21) 'Tarifa Base Estalvi ESTAT i CANARIAS If i1 <> PARMS(0, 21) And CTL.Name = "TextBox232" & i1 & "2" Then CTL.Text = PARMS(8 + i1, 11) If CTL.Name = "TextBox232" & i1 & "3" Then CTL.Text = Format(PARMS(8 + i1, 12) * 100, "#0.00") If CTL.Name = "TextBox232" & i1 & "4" Then CTL.Text = Format(PARMS(8 + i1, 13) * 100, "#0.00") Next i1 Next CTL TextBox23.Value = PARMS(8, 14) 'Mínim exempt Base Estalvi End If End Sub Private Sub Cancelar_Click() SORTIR = True IMPOST(1) = True Unload Me End Sub Private Sub CheckBox10_Click() Dim i1 As Integer If CheckBox10.Value Then Frame10.Enabled = True For Each CTL In Frame10.Controls CTL.Enabled = True Next CTL O_BI.Value = True Label1102.Top = 0 Else Frame10.Enabled = False For Each CTL In Frame10.Controls CTL.Enabled = False Next CTL Frame1123.Visible = False Frame1122.Left = 72 Label101.Visible = False Label102.Visible = False Label1102.Top = 20 Label1103.Visible = False Label1104.Visible = False O_BI.Value = False O_BL.Value = False TextBox10.Value = "0" TextBox10.Visible = False End If End Sub Private Sub CheckBox11_Click() If CheckBox11.Value Then Frame11.Enabled = True For Each CTL In Frame11.Controls CTL.Enabled = True Next CTL Else Frame11.Enabled = False For Each CTL In Frame11.Controls CTL.Enabled = False If TypeName(CTL) = "TextBox" Then CTL.Value = "0" Next CTL End If End Sub Private Sub CheckBox12_Click() If CheckBox12.Value Then Frame12.Enabled = True For Each CTL In Frame12.Controls CTL.Enabled = True Next CTL Else Frame12.Enabled = False For Each CTL In Frame12.Controls CTL.Enabled = False If TypeName(CTL) = "TextBox" Then CTL.Value = "0" Next CTL End If End Sub Private Sub CheckBox13_Click() If CheckBox13.Value Then Frame13.Enabled = True For Each CTL In Frame13.Controls CTL.Enabled = True Next CTL Else Frame13.Enabled = False For Each CTL In Frame13.Controls CTL.Enabled = False If TypeName(CTL) = "TextBox" Then CTL.Value = "0" Next CTL End If End Sub Private Sub CheckBox14_Click() If CheckBox14.Value Then Frame14.Enabled = True For Each CTL In Frame14.Controls CTL.Enabled = True Next CTL TextBox1411.Enabled = False TextBox1421.Enabled = False TextBox1425.Enabled = False Else Frame14.Enabled = False For Each CTL In Frame14.Controls CTL.Enabled = False If TypeName(CTL) = "TextBox" Then CTL.Value = "0" Next CTL End If End Sub Private Sub CheckBox15_Click() If CheckBox15.Value Then Frame15.Enabled = True For Each CTL In Frame15.Controls CTL.Enabled = True Next CTL Else Frame15.Enabled = False For Each CTL In Frame15.Controls CTL.Enabled = False If TypeName(CTL) = "TextBox" Then CTL.Value = "0" Next CTL End If End Sub Private Sub CheckBox3_Click() If CheckBox3 Then Frame3.Enabled = True For Each CTL In Frame3.Controls CTL.Enabled = True Next CTL Else Frame3.Enabled = False For Each CTL In Frame3.Controls CTL.Enabled = False If TypeName(CTL) = "TextBox" Then CTL.Value = "0" Next CTL ListBox31.Selected(11) = True ListBox32.Selected(11) = True ListBox33.Selected(11) = True ListBox361.Selected(5) = True: ListBox362.Selected(5) = True: ListBox363.Selected(5) = True ListBox39.Selected(11) = True ListBox3111.Selected(11) = True: ListBox3112.Selected(11) = True ListBox312.Selected(11) = True ListBox313.Selected(11) = True ListBox3151.Selected(11) = True: ListBox3152.Selected(11) = True ListBox3161.Selected(11) = True: ListBox3162.Selected(11) = True: ListBox3163.Selected(11) = True ListBox320.Selected(11) = True ListBox321.Selected(11) = True End If End Sub Private Sub EmplenaValors_Click() Dim i1 As Integer If ISIMULS(1) <> 0 Then Frame041.Visible = True SimulRef.Value = False End If If MultiPage1.Value = 0 Then CheckBox10.Value = False CheckBox11.Value = True 'MPF Label1102.Top = 20 For i1 = 1 To 11 For Each CTL In Frame1121.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = IRPF_MPF(i1, 1) 'ESTAT Next CTL For Each CTL In Frame1122.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = IRPF_MPF(i1, 2) 'CATALUNYA (BASE < LIM_BASE) Next CTL Next i1 For i1 = 1 To 11 For Each CTL In Frame1123.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = 0 'CATALUNYA (BASE >= LIM_BASE) Next CTL Next i1 CheckBox12.Value = True 'Tributació conjunta TextBox121.Value = IRPF_RED_RTC(1) TextBox122.Value = IRPF_RED_RTC(2) CheckBox13.Value = True 'Despeses deduïbles Rendiments Treball TextBox131.Value = IRPF_DD_RT(1) TextBox132.Value = IRPF_DD_RT(2) TextBox133.Value = IRPF_DD_RT(3) TextBox134.Value = IRPF_DD_RT(4) CheckBox14.Value = True 'Reducció Rendiments Treball TextBox1412.Value = IRPF_RED_RT(1, 2) TextBox1413.Value = IRPF_RED_RT(1, 3) TextBox1422.Value = IRPF_RED_RT(2, 2) TextBox1423.Value = IRPF_RED_RT(2, 3) TextBox1424.Value = IRPF_RED_RT(2, 4) CheckBox15.Value = True 'Reduccions Plans Pensions TextBox151.Value = IRPF_RED_PP(1) TextBox152.Value = IRPF_RED_PP(2) TextBox153.Value = IRPF_RED_PP(3) TextBox154.Value = IRPF_RED_PP(4) TotsSi.Value = True ListBox021.Selected(150) = True 'Projeccions ListBox022.Selected(150) = True ListBox023.Selected(150) = True ListBox024.Selected(150) = True ListBox025.Selected(150) = True ListBox_Proj.Selected(UBound(A_PROJ)) = True ElseIf MultiPage1.Value = 1 Then ListBox21.Selected(10 - IRPF_NTRAMSG(1)) = True 'Trams Base General ESTAT For Each CTL In Frame212.Controls For i1 = 1 To IRPF_NTRAMSG(1) 'Tarifa Base General ESTAT If i1 <> IRPF_NTRAMSG(1) And CTL.Name = "TextBox212" & i1 & "2" Then CTL.Text = IRPF_TRAMSG(i1, 1) If CTL.Name = "TextBox212" & i1 & "3" Then CTL.Text = Format(IRPF_TIPUSG(i1, 1) * 100, "#0.00") Next i1 Next CTL ListBox221.Selected(10 - IRPF_NTRAMSG(2)) = True 'Trams Base General CATALUNYA (BASE < LIMIT_BASE) For Each CTL In Frame2212.Controls For i1 = 1 To IRPF_NTRAMSG(2) 'Tarifa Base General CATALUNYA (BASE < LIMIT_BASE) If i1 <> IRPF_NTRAMSG(2) And CTL.Name = "TextBox2212" & i1 & "2" Then CTL.Text = IRPF_TRAMSG(i1, 2) If CTL.Name = "TextBox2212" & i1 & "3" Then CTL.Text = Format(IRPF_TIPUSG(i1, 2) * 100, "#0.00") Next i1 Next CTL If LIM_BASE <> 0 Then ListBox222.Selected(10 - IRPF_NTRAMSG(2)) = True 'Trams Base General CATALUNYA (BASE >= LIMIT_BASE) For Each CTL In Frame2222.Controls For i1 = 1 To IRPF_NTRAMSG(2) 'Tarifa Base General CATALUNYA (BASE >= LIMIT_BASE) If i1 <> IRPF_NTRAMSG(2) And CTL.Name = "TextBox2222" & i1 & "2" Then CTL.Text = IRPF_TRAMSG(i1, 2) If CTL.Name = "TextBox2222" & i1 & "3" Then CTL.Text = Format(IRPF_TIPUSG(i1, 2) * 100, "#0.00") Next i1 Next CTL End If ListBox23.Selected(10 - IRPF_NTRAMSE) = True 'Trams Base Estalvi For Each CTL In Frame232.Controls For i1 = 1 To IRPF_NTRAMSE 'Tarifa Base Estalvi ESTAT i CATALUNYA If i1 <> IRPF_NTRAMSE And CTL.Name = "TextBox232" & i1 & "2" Then CTL.Text = IRPF_TRAMSE(i1) If CTL.Name = "TextBox232" & i1 & "3" Then CTL.Text = Format(IRPF_TIPUSE(i1, 1) * 100, "#0.00") If CTL.Name = "TextBox232" & i1 & "4" Then CTL.Text = Format(IRPF_TIPUSE(i1, 2) * 100, "#0.00") Next i1 Next CTL TextBox23.Value = IRPF_EXEMPTE 'Mínim Exempt Base Estalvi ElseIf MultiPage1.Value = 2 Then CheckBox3.Value = True 'Deduccions autonòmiques ListBox31.Selected(5 - IRPF_DA(1, 1)) = True: TextBox31.Value = IRPF_DA(1, 2) ListBox32.Selected(5 - IRPF_DA(2, 1)) = True: TextBox32.Value = IRPF_DA(2, 2) ListBox33.Selected(5 - IRPF_DA(3, 1)) = True TextBox341.Value = IRPF_DA(4, 1): TextBox342.Value = IRPF_DA(4, 2) TextBox35.Value = IRPF_DA(5, 1) ListBox361.Selected(4 - IRPF_DA(6, 1)) = True: TextBox361.Value = IRPF_DA(6, 2): ListBox362.Selected(3 - IRPF_DA(6, 3)) = True: TextBox362.Value = IRPF_DA(6, 4): ListBox363.Selected(2 - IRPF_DA(6, 5)) = True: TextBox363.Value = IRPF_DA(6, 6) TextBox371.Value = IRPF_DA(7, 1): TextBox372.Value = IRPF_DA(7, 2): TextBox373.Value = IRPF_DA(7, 3): TextBox374.Value = IRPF_DA(7, 4): TextBox375.Value = IRPF_DA(7, 5): TextBox376.Value = IRPF_DA(7, 6) TextBox381.Value = IRPF_DA(8, 1): TextBox382.Value = IRPF_DA(8, 2) ListBox39.Selected(5 - IRPF_DA(9, 1)) = True: TextBox39.Value = IRPF_DA(9, 2) TextBox3101.Value = IRPF_DA(10, 1): TextBox3102.Value = IRPF_DA(10, 2): TextBox3103.Value = IRPF_DA(10, 3): TextBox3104.Value = IRPF_DA(10, 4) ListBox3111.Selected(5 - IRPF_DA(11, 1)) = True: ListBox3112.Selected(9 - IRPF_DA(11, 2)) = True ListBox312.Selected(5 - IRPF_DA(12, 1)) = True ListBox313.Selected(5 - IRPF_DA(13, 1)) = True: TextBox313.Value = IRPF_DA(13, 2) TextBox314.Value = IRPF_DA(14, 1) ListBox3151.Selected(5 - IRPF_DA(15, 1)) = True: ListBox3152.Selected(5 - IRPF_DA(15, 2)) = True ListBox3161.Selected(5 - IRPF_DA(16, 1)) = True: ListBox3162.Selected(5 - IRPF_DA(16, 2)) = True: ListBox3163.Selected(9 - IRPF_DA(16, 3)) = True TextBox317.Value = IRPF_DA(17, 1) TextBox318.Value = IRPF_DA(18, 1) TextBox319.Value = IRPF_DA(19, 1) ListBox320.Selected(5 - IRPF_DA(20, 1)) = True: TextBox320.Value = IRPF_DA(20, 2) ListBox321.Selected(5 - IRPF_DA(21, 1)) = True: TextBox3211.Value = IRPF_DA(21, 2): TextBox3212.Value = IRPF_DA(21, 3): TextBox3213.Value = IRPF_DA(21, 4) TextBox322.Value = IRPF_DA(22, 1) End If End Sub Private Sub ListBox_Simulref_Click() Dim i1 As Integer, nsim As Integer, p(42, 27) For i1 = 0 To ISIMULS(1) - 1 If ListBox_SimulRef.Selected(i1) = True Then nsim = ListBox_SimulRef.Value Exit For End If Next i1 Call COMUNS_1REFERENCIA_SIMULS("IRPF", nsim, p) If MultiPage1.Value = 0 Then If p(0, 3) = "TOTS" Then TotsSi.Value = True Else TotsNo.Value = True 'Declarants ListBox_Proj.Selected(LBound(A_PROJ)) = True 'Projeccions a l'anys fiscal For i1 = 0 To UBound(A_PROJ) If p(0, 4) = A_PROJ(i1) Then ListBox_Proj.Selected(i1) = True Exit For End If Next i1 ListBox021.Selected(150 - ((p(0, 5) - 1) * 1000)) = True 'Projeccions per tipus de rendiments ListBox022.Selected(150 - ((p(0, 6) - 1) * 1000)) = True ListBox023.Selected(150 - ((p(0, 7) - 1) * 1000)) = True ListBox024.Selected(150 - ((p(0, 8) - 1) * 1000)) = True ListBox025.Selected(150 - ((p(0, 9) - 1) * 1000)) = True If p(0, 11) >= 1 Then CheckBox10.Value = True 'Discriminació per BASE If p(0, 11) = 1 Then O_BI.Value = True If p(0, 11) = 2 Then O_BL.Value = True TextBox10.Value = p(0, 12) 'Límit BASE per a discriminar MPF i Tarifa Base General CATALUNYA Else CheckBox10.Value = False End If If p(0, 13) = 1 Then CheckBox11.Value = True Else CheckBox11.Value = False 'MPF For i1 = 1 To 11 For Each CTL In Frame1121.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = p(1, i1) 'ESTAT Next CTL For Each CTL In Frame1122.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = p(2, i1) 'CATALUNYA (BIT < LIM_BIT) Next CTL Next i1 If LIM_BASE <> 0 Then For i1 = 1 To 11 For Each CTL In Frame1123.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = p(3, i1) 'CATALUNYA (BIT >= LIM_BIT) Next CTL Next i1 End If If p(0, 14) = 1 Then CheckBox12.Value = True Else CheckBox12.Value = False 'Reducció Tributació conjunta TextBox121.Value = p(4, 1) TextBox122.Value = p(4, 2) If p(0, 15) = 1 Then CheckBox13.Value = True Else CheckBox13.Value = False 'Despeses deduïbles Rendiments Treball TextBox131.Value = p(5, 1) TextBox132.Value = p(5, 2) TextBox133.Value = p(5, 3) TextBox134.Value = p(5, 4) If p(0, 16) = 1 Then CheckBox14.Value = True Else CheckBox14.Value = False 'Reducció Rendiments Treball TextBox1412.Value = p(6, 2) TextBox1413.Value = p(6, 3) TextBox1422.Value = p(7, 2) TextBox1423.Value = p(7, 3) TextBox1424.Value = p(7, 4) If p(0, 17) = 1 Then CheckBox15.Value = True Else CheckBox15.Value = False 'Reduccions Plans de Pensions TextBox151.Value = p(8, 1) TextBox152.Value = p(8, 2) TextBox153.Value = p(8, 3) TextBox154.Value = p(8, 4) ElseIf MultiPage1.Value = 1 Then ListBox21.Selected(10 - p(0, 18)) = True 'Trams Base General ESTAT For Each CTL In Frame212.Controls For i1 = 1 To p(0, 18) 'Tarifa Base General ESTAT If i1 <> p(0, 18) And CTL.Name = "TextBox212" & i1 & "2" Then CTL.Text = p(8 + i1, 2) If CTL.Name = "TextBox212" & i1 & "3" Then CTL.Text = Format(p(8 + i1, 3) * 100, "#0.00") Next i1 Next CTL ListBox221.Selected(10 - p(0, 19)) = True 'Trams Base General CATALUNYA (BIT < LIMIT_BIT) For Each CTL In Frame2212.Controls For i1 = 1 To p(0, 19) 'Tarifa Base General CATALUNYA (BIT < LIMIT_BIT) If i1 <> p(0, 19) And CTL.Name = "TextBox2212" & i1 & "2" Then CTL.Text = p(8 + i1, 5) If CTL.Name = "TextBox2212" & i1 & "3" Then CTL.Text = Format(p(8 + i1, 6) * 100, "#0.00") Next i1 Next CTL If p(0, 12) <> 0 Then ListBox222.Selected(10 - p(0, 20)) = True 'Trams Base General CATALUNYA (BIT >= LIMIT_BIT) For Each CTL In Frame2222.Controls For i1 = 1 To p(0, 20) 'Tarifa Base General CATALUNYA (BIT >= LIMIT_BIT) If i1 <> p(0, 20) And CTL.Name = "TextBox2222" & i1 & "2" Then CTL.Text = p(8 + i1, 5) If CTL.Name = "TextBox2222" & i1 & "3" Then CTL.Text = Format(p(8 + i1, 6) * 100, "#0.00") Next i1 Next CTL End If ListBox23.Selected(10 - p(0, 21)) = True 'Trams Base Estalvi For Each CTL In Frame232.Controls For i1 = 1 To p(0, 21) 'Tarifa Base Estalvi ESTAT i CANARIAS If i1 <> p(0, 21) And CTL.Name = "TextBox232" & i1 & "2" Then CTL.Text = p(8 + i1, 11) If CTL.Name = "TextBox232" & i1 & "3" Then CTL.Text = Format(p(8 + i1, 12) * 100, "#0.00") If CTL.Name = "TextBox232" & i1 & "4" Then CTL.Text = Format(p(8 + i1, 13) * 100, "#0.00") Next i1 Next CTL TextBox23.Value = p(8, 14) 'Mínim exempt Base Estalvi ElseIf MultiPage1.Value = 2 Then If p(0, 23) = 1 Then CheckBox3.Value = True Else CheckBox3.Value = False 'Deduccions CANARIAS ' TextBox4211.Value = p(31, 1) ' ListBox4221.Selected(40 - p(32, 1) * 100) = True: ListBox4222.Selected(15 - p(32, 2) * 100) = True ' ListBox4231.Selected(40 - p(33, 1) * 100) = True: ListBox4232.Selected(15 - p(33, 2) * 100) = True ' ListBox4241.Selected(15 - p(34, 1) * 100) = True: TextBox4242.Value = p(34, 2) ' For i1 = 0 To 10 ' If p(35, 1) * 10 = i1 Then ' ListBox4251.Selected(10 - i1) = True ' Exit For ' End If ' Next i1 ' TextBox4261.Value = p(36, 1) ' For i1 = 0 To 10 ' If p(37, 1) * 10 = 5 - (0.5 * i1) Then ' ListBox4271.Selected(i1) = True ' Exit For ' End If ' Next i1 ' TextBox4272.Value = p(37, 2) ' ListBox4281.Selected(40 - p(38, 1) * 100) = True: ListBox4282.Selected(15 - p(38, 2) * 100) = True ' ListBox4291.Selected(40 - p(39, 1) * 100) = True: TextBox4292.Value = p(39, 2) ' ListBox42101.Selected(50 - p(40, 1) * 100) = True: TextBox42102.Value = p(40, 2) ' ListBox42111.Selected(40 - p(41, 1) * 100) = True: TextBox42112.Value = p(41, 2) End If End Sub Private Sub ListBox_Proj_Click() ANY_PROJ = ListBox_Proj.Value 'Any a projectar If ANY_PROJ = ANOIRPF Then Frame02.Enabled = True For Each CTL In Frame02.Controls CTL.Enabled = True Next CTL Else Frame02.Enabled = False For Each CTL In Frame02.Controls CTL.Enabled = False If TypeName(CTL) = "ListBox" Then CTL.Selected(150) = True Next CTL End If End Sub Private Sub ListBox021_Click() If MultiPage1.Value = 0 Then PROJ(1) = 1 + (ListBox021.Value / 100) End Sub Private Sub ListBox022_Click() If MultiPage1.Value = 0 Then PROJ(2) = 1 + (ListBox022.Value / 100) End Sub Private Sub ListBox023_Click() If MultiPage1.Value = 0 Then PROJ(3) = 1 + (ListBox023.Value / 100) End Sub Private Sub ListBox024_Click() If MultiPage1.Value = 0 Then PROJ(4) = 1 + (ListBox024.Value / 100) End Sub Private Sub ListBox025_Click() If MultiPage1.Value = 0 Then PROJ(5) = 1 + (ListBox025.Value / 100) End Sub Private Sub ListBox21_Click() Dim i1 As Integer NTRAMS = ListBox21.Value For Each CTL In Frame211.Controls If CTL.TabIndex <= NTRAMS - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame212.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMS - 1 If CTL.TabIndex = 3 * i1 + 1 Or CTL.TabIndex = 3 * i1 + 2 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox212" & NTRAMS & "2" Then CTL.Enabled = False CTL.Value = IIf(NTRAMS > 1, "y más", "máximo") End If Next CTL TextBox21211.Value = "0" End Sub Private Sub ListBox221_Click() Dim i1 As Integer NTRAMS = ListBox221.Value For Each CTL In Frame2211.Controls If CTL.TabIndex <= NTRAMS - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame2212.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMS - 1 If CTL.TabIndex = 3 * i1 + 1 Or CTL.TabIndex = 3 * i1 + 2 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox2212" & NTRAMS & "2" Then CTL.Enabled = False CTL.Value = IIf(NTRAMS > 1, "y más", "máximo") End If Next CTL TextBox221211.Value = "0" End Sub Private Sub ListBox222_Click() Dim i1 As Integer If LIM_BASE <> 0 Then NTRAMS = ListBox222.Value For Each CTL In Frame2221.Controls If CTL.TabIndex <= NTRAMS - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame2222.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMS - 1 If CTL.TabIndex = 3 * i1 + 1 Or CTL.TabIndex = 3 * i1 + 2 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox2222" & NTRAMS & "2" Then CTL.Enabled = False CTL.Value = IIf(NTRAMS > 1, "y más", "màxim") End If Next CTL TextBox222211.Value = "0" End If End Sub Private Sub ListBox23_Click() Dim i1 As Integer NTRAMSE = ListBox23.Value For Each CTL In Frame231.Controls If CTL.TabIndex <= NTRAMSE - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame232.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMSE - 1 If CTL.TabIndex = (4 * i1) + 1 Or CTL.TabIndex = (4 * i1) + 2 Or _ CTL.TabIndex = (4 * i1) + 3 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox232" & NTRAMSE & "2" Then CTL.Enabled = False CTL.Value = IIf(NTRAMSE > 1, "y más", "máximo") End If Next CTL TextBox23211.Value = "0" End Sub Private Sub MultiPage1_Layout(ByVal Index As Long) Dim i1 As Integer If MultiPage1.Value = 0 Then Aceptar.Left = 277 Anterior.Visible = False Cancelar.Left = 325 Frame01.Enabled = True For Each CTL In Frame01.Controls CTL.Enabled = True Next CTL Frame02.Enabled = True For Each CTL In Frame03.Controls CTL.Enabled = True Next CTL Frame03.Enabled = True For Each CTL In Frame03.Controls CTL.Enabled = True Next CTL Frame04.Enabled = True For Each CTL In Frame04.Controls CTL.Enabled = True Next CTL Else For i1 = 0 To UBound(A_PROJ) If ANY_PROJ = A_PROJ(i1) Then ListBox_Proj.Selected(i1) = True Exit For End If Next i1 Aceptar.Left = 300 Anterior.Visible = True Cancelar.Left = 348 Frame01.Enabled = False If DECL_NOMBRE = "TOTS" Then TotsSi.Value = True Else TotsNo.Value = True For Each CTL In Frame01.Controls CTL.Enabled = False Next CTL Frame02.Enabled = False For Each CTL In Frame02.Controls For i1 = 1 To 5 If CTL.Name = "ListBox02" & i1 Then CTL.Selected(150 - ((PROJ(i1) - 1) * 1000)) = True Next i1 CTL.Enabled = False Next CTL Frame03.Enabled = False For Each CTL In Frame03.Controls CTL.Enabled = False Next CTL End If End Sub Private Sub NetejaValors_Click() Dim i1 As Integer If MultiPage1.Value = 0 Then SimulRef.Value = False CheckBox10.Value = False CheckBox11.Value = False CheckBox12.Value = False CheckBox13.Value = False CheckBox14.Value = False CheckBox15.Value = False ElseIf MultiPage1.Value = 1 Then SimulRef.Value = False ListBox21.Selected(9) = True TextBox21213.Value = "12,00" ListBox221.Selected(9) = True TextBox221213.Value = "12,00" ListBox222.Selected(9) = True TextBox222213.Value = "12,00" ListBox23.Selected(9) = True TextBox23213.Value = "12,00" TextBox23214.Value = "12,00" ElseIf MultiPage1.Value = 2 Then SimulRef.Value = False CheckBox3.Value = False End If End Sub Private Sub O_BI_Click() Dim i1 As Integer If O_BI.Value = True Then Label101.Visible = True Label101.Caption = "Límite BIT:" Label102.Visible = True TextBox10.Visible = True TextBox10.Value = 60000 Label1103.Visible = True Label1103.Caption = "BIT inferior a " & Format(TextBox10.Value, "###,###0") & "€" Label1104.Visible = True Label1104.Caption = "BIT superior a " & Format(TextBox10.Value, "###,###0") & "€" Frame1122.Left = 48 Frame1123.Visible = True For i1 = 1 To 13 For Each CTL In Frame1123.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = IRPF_MPF(i1, 2) Next CTL Next i1 Else Label101.Visible = False Label101.Caption = "" Label102.Visible = False TextBox10.Visible = False TextBox10.Value = "" End If End Sub Private Sub O_BL_Click() Dim i1 As Integer If O_BL.Value = True Then Label101.Visible = True Label101.Caption = "Límite BLT:" Label102.Visible = True TextBox10.Visible = True TextBox10.Value = 60000 Label1103.Visible = True Label1103.Caption = "BLT inferior a " & Format(TextBox10.Value, "###,###0") & "€" Label1104.Visible = True Label1104.Caption = "BLT superior a " & Format(TextBox10.Value, "###,###0") & "€" Frame1122.Left = 48 Frame1123.Visible = True For i1 = 1 To 13 For Each CTL In Frame1123.Controls If CTL.TabIndex = i1 - 1 Then CTL.Value = IRPF_MPF(i1, 2) Next CTL Next i1 Else Label101.Visible = False Label101.Caption = "" Label102.Visible = False TextBox10.Visible = False TextBox10.Value = "" End If End Sub Private Sub SimulRef_Change() Dim i1 As Integer If SimulRef Then ListBox_SimulRef.Visible = True For i1 = 0 To ISIMULS(1) - 1 ListBox_SimulRef.Selected(i1) = False Next i1 Else ListBox_SimulRef.TopIndex = 0 ListBox_SimulRef.Visible = False End If End Sub Private Sub TextBox10_Change() If IsNumeric(TextBox10.Value) Then Label1103.Caption = IIf(O_BI, "BIT", "BLT") & " inferior a " & Format(TextBox10.Value, "###,###0") & "€" Label1104.Caption = IIf(O_BI, "BIT", "BLT") & " superior a " & Format(TextBox10.Value, "###,###0") & "€" End If End Sub Private Sub TextBox1412_Change() If IsNumeric(TextBox1412.Value) Then TextBox1421.Value = TextBox1412.Value TextBox1425.Value = TextBox1412.Value End If End Sub Private Sub TextBox1413_Change() If IsNumeric(TextBox1413.Value) Then TextBox1423.Value = TextBox1413.Value End Sub Private Sub TextBox21212_Change() If IsNumeric(TextBox21212.Value) Then TextBox21221.Value = TextBox21212.Value End Sub Private Sub TextBox21222_Change() If IsNumeric(TextBox21222.Value) Then TextBox21231.Value = TextBox21222.Value End Sub Private Sub TextBox21232_Change() If IsNumeric(TextBox21232.Value) Then TextBox21241.Value = TextBox21232.Value End Sub Private Sub TextBox21242_Change() If IsNumeric(TextBox21242.Value) Then TextBox21251.Value = TextBox21242.Value End Sub Private Sub TextBox21252_Change() If IsNumeric(TextBox21252.Value) Then TextBox21261.Value = TextBox21252.Value End Sub Private Sub TextBox21262_Change() If IsNumeric(TextBox21262.Value) Then TextBox21271.Value = TextBox21262.Value End Sub Private Sub TextBox21272_Change() If IsNumeric(TextBox21272.Value) Then TextBox21281.Value = TextBox21272.Value End Sub Private Sub TextBox21282_Change() If IsNumeric(TextBox21282.Value) Then TextBox21291.Value = TextBox21282.Value End Sub Private Sub TextBox21292_Change() If IsNumeric(TextBox21292.Value) Then TextBox212101.Value = TextBox21292.Value End Sub Private Sub Textbox221212_Change() If IsNumeric(TextBox221212.Value) Then TextBox221221.Value = TextBox221212.Value End Sub Private Sub Textbox221222_Change() If IsNumeric(TextBox221222.Value) Then TextBox221231.Value = TextBox221222.Value End Sub Private Sub Textbox221232_Change() If IsNumeric(TextBox221232.Value) Then TextBox221241.Value = TextBox221232.Value End Sub Private Sub Textbox221242_Change() If IsNumeric(TextBox221242.Value) Then TextBox221251.Value = TextBox221242.Value End Sub Private Sub Textbox221252_Change() If IsNumeric(TextBox221252.Value) Then TextBox221261.Value = TextBox221252.Value End Sub Private Sub Textbox221262_Change() If IsNumeric(TextBox221262.Value) Then TextBox221271.Value = TextBox221262.Value End Sub Private Sub Textbox221272_Change() If IsNumeric(TextBox221272.Value) Then TextBox221281.Value = TextBox221272.Value End Sub Private Sub Textbox221282_Change() If IsNumeric(TextBox221282.Value) Then TextBox221291.Value = TextBox221282.Value End Sub Private Sub Textbox221292_Change() If IsNumeric(TextBox221292.Value) Then TextBox2212101.Value = TextBox221292.Value End Sub Private Sub Textbox222212_Change() If IsNumeric(TextBox222212.Value) Then TextBox222221.Value = TextBox222212.Value End Sub Private Sub Textbox222222_Change() If IsNumeric(TextBox222222.Value) Then TextBox222231.Value = TextBox222222.Value End Sub Private Sub Textbox222232_Change() If IsNumeric(TextBox222232.Value) Then TextBox222241.Value = TextBox222232.Value End Sub Private Sub Textbox222242_Change() If IsNumeric(TextBox222242.Value) Then TextBox222251.Value = TextBox222242.Value End Sub Private Sub Textbox222252_Change() If IsNumeric(TextBox222252.Value) Then TextBox222261.Value = TextBox222252.Value End Sub Private Sub Textbox222262_Change() If IsNumeric(TextBox222262.Value) Then TextBox222271.Value = TextBox222262.Value End Sub Private Sub Textbox222272_Change() If IsNumeric(TextBox222272.Value) Then TextBox222281.Value = TextBox222272.Value End Sub Private Sub Textbox222282_Change() If IsNumeric(TextBox222282.Value) Then TextBox222291.Value = TextBox222282.Value End Sub Private Sub Textbox222292_Change() If IsNumeric(TextBox222292.Value) Then TextBox2222101.Value = TextBox222292.Value End Sub Private Sub Textbox23212_Change() If IsNumeric(TextBox23212.Value) Then TextBox23221.Value = TextBox23212.Value End Sub Private Sub Textbox23222_Change() If IsNumeric(TextBox23222.Value) Then TextBox23231.Value = TextBox23222.Value End Sub Private Sub Textbox23232_Change() If IsNumeric(TextBox23232.Value) Then TextBox23241.Value = TextBox23232.Value End Sub Private Sub Textbox23242_Change() If IsNumeric(TextBox23242.Value) Then TextBox23251.Value = TextBox23242.Value End Sub Private Sub Textbox23252_Change() If IsNumeric(TextBox23252.Value) Then TextBox23261.Value = TextBox23252.Value End Sub Private Sub Textbox23262_Change() If IsNumeric(TextBox23262.Value) Then TextBox23271.Value = TextBox23262.Value End Sub Private Sub Textbox23272_Change() If IsNumeric(TextBox23272.Value) Then TextBox23281.Value = TextBox23272.Value End Sub Private Sub Textbox23282_Change() If IsNumeric(TextBox23282.Value) Then TextBox23291.Value = TextBox23282.Value End Sub Private Sub Textbox23292_Change() If IsNumeric(TextBox23292.Value) Then TextBox232101.Value = TextBox23292.Value End Sub Private Sub TextBox325_Change() End Sub Private Sub UserForm_Activate() height1 = Me.Height left1 = Me.Left top1 = Me.Top width1 = Me.Width EmplenaValors.Value = True ListBox_SimulRef.Visible = False End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then SORTIR = True Unload Me End Sub Private Sub UserForm_Zoom(Percent As Integer) Me.Width = Me.Width * Percent / 100 Me.Height = Me.Height * Percent / 100 Me.Left = left1 - ((Me.Width - width1) / 2) Me.Top = top1 - ((Me.Width - width1) / 2) End Sub VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} IS1 Caption = "IS" ClientHeight = 8076 ClientLeft = 48 ClientTop = 456 ClientWidth = 11028 OleObjectBlob = "IS1.frx":0000 StartUpPosition = 1 'Centrar en propietario End Attribute VB_Name = "IS1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim height1 As Integer, left1 As Integer, top1 As Integer, width1 As Integer Private Sub Aceptar_Click() Dim i1 As Integer, j1 As Integer ERR_LEC = False If MultiPage1.Value = 0 Then ReDim R301(1 To 7, 1 To 3) 'Reduccions parentiu For Each CTL In Frame11.Controls For i1 = 1 To 7 If CTL.Name = "TextBox11" & i1 Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la reducció per parentiu ", _ IIf(i1 = 1, "del Grup 1", _ IIf(i1 = 2, "del Grup II (cònjuge)", _ IIf(i1 = 3, "del Grup II (fills i adoptats)", _ IIf(i1 = 4, "del Grup II (ascendents i adoptants)", _ IIf(i1 = 5, "del Grup II (resta descendents)", _ IIf(i1 = 6, "del Grup III", "del Grup IV (convivència mútua)")))))), vbCritical, TITOL_IS Exit Sub Else R301(i1, 1) = Val(Replace(CTL.Value, ",", ".")) End If End If Next i1 Next CTL If Not IsNumeric(TextBox1111.Value) Or Val(TextBox1111.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en l'increment en la reducció per parentiu del Grup I.", vbCritical, TITOL_IS Exit Sub Else R301(1, 2) = Val(Replace(TextBox1111.Value, ",", ".")) End If If Not IsNumeric(TextBox1112.Value) Or Val(TextBox1112.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el límit de la reducció per parentiu del Grup I.", vbCritical, TITOL_IS Exit Sub Else R301(1, 3) = Val(Replace(TextBox1112.Value, ",", ".")) End If ReDim R302(1 To 2) 'Reducció minusvalidesa If Not IsNumeric(TextBox1211.Value) Or Val(TextBox1211.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la reducció per discapacitat 33%-65%.", vbCritical, TITOL_IS Exit Sub Else R302(1) = Val(Replace(TextBox1211.Value, ",", ".")) End If If Not IsNumeric(TextBox1212.Value) Or Val(TextBox1212.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la reducció per discapacitat >65%.", vbCritical, TITOL_IS Exit Sub Else R302(2) = Val(Replace(TextBox1212.Value, ",", ".")) End If If R302(1) > R302(2) Then ERR_LEC = True Me.Hide MsgBox "Error en la reducció per discapacitat, no pot ser superior la del 33% que la del 65%.", vbCritical, TITOL_IS Exit Sub End If ReDim R303(1 To 2) 'Reducció persones grans R303(1) = ListBox122.Value If Not IsNumeric(TextBox1221.Value) Or Val(TextBox1221.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en la reducció per edat.", vbCritical, TITOL_IS Exit Sub Else R303(2) = Val(Replace(TextBox1221.Value, ",", ".")) End If ReDim R306(1 To 1) 'Reducció empresa individual o negoci professional R306(1) = Val(ListBox131.Value) / 100 ReDim R307(1 To 3) 'Reducció participacions: entitats, societats laborals, vincle laboral R307(1) = Val(ListBox132.Value) / 100 R307(2) = Val(ListBox133.Value) / 100 R307(3) = Val(ListBox134.Value) / 100 ReDim R310(1 To 6) 'Reducció explotacions agràries R310(1) = Val(ListBox135.Value) / 100 R310(2) = Val(ListBox136.Value) / 100 R310(3) = Val(ListBox137.Value) / 100 R310(4) = Val(ListBox138.Value) / 100 R310(5) = Val(ListBox139.Value) / 100 R310(6) = Val(ListBox1310.Value) / 100 ReDim R311(1 To 1) 'Reducció finques rústiques R311(1) = Val(ListBox1311.Value) / 100 ReDim R309(1 To 1) 'Reducció béns culturals R309(1) = Val(ListBox1312.Value) / 100 ReDim R312(1 To 2) 'Reducció béns patrimoni natural i altres R312(1) = Val(ListBox1313.Value) / 100 R312(2) = Val(ListBox1314.Value) / 100 ReDim R305(1 To 2) 'Reducció assegurances R305(1) = Val(ListBox1315.Value) / 100 If Not IsNumeric(TextBox1315.Value) Or Val(TextBox1315.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el límit de la reducció per assegurança sobre la vida.", vbCritical, TITOL_IS Exit Sub Else R305(2) = Val(Replace(TextBox1315.Value, ",", ".")) End If ReDim R308(1 To 2) 'Reducció habitatge R308(1) = Val(ListBox1316.Value) / 100 If Not IsNumeric(TextBox1316.Value) Or Val(TextBox1316.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el límit de la reducció per habitatge habitual.", vbCritical, TITOL_IS Exit Sub Else R308(2) = Val(Replace(TextBox1316.Value, ",", ".")) End If ReDim PARMS(51, 10) 'Guarda els paràmetres del primer quadre a PARMS' PARMS(0, 0) = "Paràmetres" PARMS(0, 1) = IS_ANYREF PARMS(1, 2) = R301(1, 2): PARMS(1, 3) = R301(1, 3) For i1 = 1 To 7 PARMS(i1, 1) = R301(i1, 1) Next i1 PARMS(8, 1) = R302(1): PARMS(8, 2) = R302(2) PARMS(9, 1) = R303(1): PARMS(9, 2) = R303(2) PARMS(10, 1) = R306(1) PARMS(11, 1) = R307(1): PARMS(11, 2) = R307(2): PARMS(11, 3) = R307(3) PARMS(12, 1) = R310(1): PARMS(12, 2) = R310(2): PARMS(12, 3) = R310(3): PARMS(12, 4) = R310(4): PARMS(12, 5) = R310(5): PARMS(12, 6) = R310(6) PARMS(13, 1) = R311(1) PARMS(14, 1) = R309(1) PARMS(15, 1) = R312(1): PARMS(15, 2) = R312(2) PARMS(16, 1) = R305(1): PARMS(16, 2) = R305(2) PARMS(17, 1) = R308(1): PARMS(17, 2) = R308(2) ElseIf MultiPage1.Value = 1 Then ReDim COEF(1 To 4, 1 To 4) For i1 = 1 To 4 If i1 <> 2 Then For j1 = 1 To 4 For Each CTL In Frame21.Controls If CTL.Name = "TextBox21" & i1 & j1 Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el coeficient multiplicador" & i1 & "," & j1 & ".", vbCritical, TITOL_IS Exit Sub Else COEF(i1, j1) = Val(Replace(CTL.Value, ",", ".")) End If End If Next CTL Next j1 End If For j1 = 1 To 4 COEF(2, j1) = COEF(1, j1) Next j1 Next i1 NTRAMS12 = ListBox22.Value 'Trams i tipus grups 1 i 2 ReDim TIPUS12(1 To NTRAMS12), T12(1 To NTRAMS12) For i1 = 1 To NTRAMS12 For Each CTL In Frame222.Controls If i1 <> NTRAMS12 Then If CTL.Name = "TextBox222" & i1 & "2" Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " del grup parentiu 1 i 2.", vbCritical, TITOL_IS Exit Sub Else T12(i1) = Val(Replace(CTL.Value, ",", ".")) End If End If End If If CTL.Name = "TextBox222" & i1 & "3" Then If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu del TRAM " & i1 & " del grup parentiu 1 i 2.", vbCritical, TITOL_IS Exit Sub Else TIPUS12(i1) = Val(Replace(CTL.Value, ",", ".")) / 100 End If End If Next CTL If i1 <> 1 Then If i1 <> NTRAMS12 Then If T12(i1) <= T12(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " del grup parentiu 1 i 2.", vbCritical, TITOL_IS Exit Sub End If End If If TIPUS12(i1) < TIPUS12(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu del TRAM " & i1 & " del grup parentiu 1 i 2.", vbCritical, TITOL_IS Exit Sub End If End If Next i1 NTRAMS34 = ListBox23.Value 'Trams i tipus grups 3 i 4 ReDim TIPUS34(1 To NTRAMS34), T34(1 To NTRAMS34) For i1 = 1 To NTRAMS34 For Each CTL In Frame232.Controls If i1 <> NTRAMS34 Then If CTL.Name = "TextBox232" & i1 & "2" Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " del grup parentiu 3 i 4.", vbCritical, TITOL_IS Exit Sub Else T34(i1) = Val(Replace(CTL.Value, ",", ".")) End If End If End If If CTL.Name = "TextBox232" & i1 & "3" Then If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu del TRAM " & i1 & " del grup parentiu 3 i 4.", vbCritical, TITOL_IS Exit Sub Else TIPUS34(i1) = Val(Replace(CTL.Value, ",", ".")) / 100 End If End If Next CTL If i1 <> 1 Then If i1 <> NTRAMS34 Then If T34(i1) <= T34(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " del grup parentiu 3 i 4.", vbCritical, TITOL_IS Exit Sub End If End If If TIPUS34(i1) < TIPUS34(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu del TRAM " & i1 & " del grup parentiu 3 i 4.", vbCritical, TITOL_IS Exit Sub End If End If Next i1 PARMS(0, 2) = NTRAMS12 'Guarda els paràmetres del segon quadre a PARMS' PARMS(0, 3) = NTRAMS34 For i1 = 1 To 4 For j1 = 1 To 4 PARMS(17 + i1, j1) = COEF(i1, j1) Next j1 Next i1 For i1 = 1 To NTRAMS12 If i1 = 1 Then PARMS(21 + i1, 1) = "0" PARMS(21 + i1, 2) = IIf(i1 <> NTRAMS12, T12(i1), "i més") PARMS(21 + i1, 3) = TIPUS12(i1) '+ 0.0000000001 ElseIf i1 < NTRAMS12 Then PARMS(21 + i1, 1) = T12(i1 - 1) PARMS(21 + i1, 2) = T12(i1) PARMS(21 + i1, 3) = TIPUS12(i1) '+ 0.0000000001 Else PARMS(21 + i1, 1) = T12(i1 - 1) PARMS(21 + i1, 2) = "i més" PARMS(21 + i1, 3) = TIPUS12(i1) '+ 0.0000000001 End If Next i1 For i1 = 1 To NTRAMS34 If i1 = 1 Then PARMS(21 + i1, 5) = "0" PARMS(21 + i1, 6) = IIf(i1 <> NTRAMS34, T34(i1), "i més") PARMS(21 + i1, 7) = TIPUS34(i1) '+ 0.0000000001 ElseIf i1 < NTRAMS34 Then PARMS(21 + i1, 5) = T34(i1 - 1) PARMS(21 + i1, 6) = T34(i1) PARMS(21 + i1, 7) = TIPUS34(i1) '+ 0.0000000001 Else PARMS(21 + i1, 5) = T34(i1 - 1) PARMS(21 + i1, 6) = "i més" PARMS(21 + i1, 7) = TIPUS34(i1) '+ 0.0000000001 End If Next i1 ElseIf MultiPage1.Value = 2 Then NTRAMS_BON_IS = ListBox241.Value 'Nombre de Trams de la bonificació ReDim BON_IS(NTRAMS_BON_IS + 1, 3) BON_IS(0, 0) = 0: BON_IS(0, 1) = 0: BON_IS(0, 2) = 0 If Not IsNumeric(TextBox24.Value) Or Val(TextBox24.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus de la bonificació de la quota dels cònjuges.", vbCritical, TITOL_IS Exit Sub Else BON_IS(0, 3) = Val(Replace(TextBox24.Value, ",", ".")) / 100 End If For i1 = 1 To NTRAMS_BON_IS For Each CTL In Frame243.Controls If i1 <> 1 Then If CTL.Name = "TextBox243" & i1 & "1" Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " de la bonificació.", vbCritical, TITOL_IS Exit Sub Else BON_IS(i1, 1) = Val(Replace(CTL.Value, ",", ".")) End If End If End If If CTL.Name = "TextBox243" & i1 & "3" Then If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus marginal del TRAM " & i1 & " de la bonificació.", vbCritical, TITOL_IS Exit Sub Else BON_IS(i1, 3) = Application.Round(Val(Replace(CTL.Value, ",", ".")) / 100, 4) End If End If Next CTL Next i1 BON_IS(1, 1) = 0: BON_IS(1, 0) = BON_IS(2, 1) For i1 = 2 To NTRAMS_BON_IS If BON_IS(i1, 1) <= BON_IS(i1 - 1, 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " de la bonificació.", vbCritical, TITOL_IS Exit Sub End If If BON_IS(i1, 3) > BON_IS(i1 - 1, 3) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus marginal del TRAM " & i1 & " de la bonificació.", vbCritical, TITOL_IS Exit Sub End If BON_IS(i1 - 1, 0) = BON_IS(i1, 1) - BON_IS(i1 - 1, 1) BON_IS(i1, 2) = Application.Round((BON_IS(i1 - 1, 1) * BON_IS(i1 - 1, 2) + BON_IS(i1 - 1, 0) * BON_IS(i1 - 1, 3)) / BON_IS(i1, 1), 4) Next i1 PER_BON_REDS = ListBox245.Value / 100 PARMS(0, 4) = NTRAMS_BON_IS 'Guarda els paràmetres del tercer quadre a PARMS' For i1 = 0 To NTRAMS_BON_IS PARMS(38 + i1, 1) = BON_IS(i1, 0) PARMS(38 + i1, 2) = BON_IS(i1, 1) PARMS(38 + i1, 3) = BON_IS(i1, 2) PARMS(38 + i1, 4) = BON_IS(i1, 3) Next i1 PARMS(51, 1) = PER_BON_REDS End If Unload Me End Sub Private Sub Anterior_Click() Dim i1 As Integer, j1 As Integer PAGINA = PAGINA - 1 MultiPage1.Value = PAGINA NetejaValors.Value = False Llei.Value = False SimulRef.Value = False If MultiPage1.Value = 0 Then Me.Caption = "SIMCAT-IS: Reduccions" & " (Base de dades: " & ANOIS & " )" For i1 = 1 To 7 'Reducció parentiu For Each CTL In Frame11.Controls If CTL.Name = "TextBox11" & i1 Then CTL.Value = Format(PARMS(i1, 1), "#0") Next CTL Next i1 TextBox1111.Value = Format(PARMS(1, 2), "#0") TextBox1112.Value = Format(PARMS(1, 3), "#0") TextBox1211.Value = PARMS(8, 1) 'Reducció minusvalidesa TextBox1212.Value = PARMS(8, 2) ListBox122.Selected(80 - PARMS(9, 1)) = True 'Reducció edat TextBox1221.Value = PARMS(9, 2) If PARMS(10, 1) <> 0 Then ListBox131.Selected(100 - (PARMS(10, 1) * 100)) = True Else ListBox131.Selected(11) = True 'Reducció empresa individual o negoci professional If PARMS(11, 1) <> 0 Then ListBox132.Selected(100 - (PARMS(11, 1) * 100)) = True Else ListBox132.Selected(11) = True 'Reducció participacions entitats If PARMS(11, 2) <> 0 Then ListBox133.Selected(100 - (PARMS(11, 2) * 100)) = True Else ListBox133.Selected(11) = True 'Reducció participacions societats laborals If PARMS(11, 3) <> 0 Then ListBox134.Selected(100 - (PARMS(11, 3) * 100)) = True Else ListBox134.Selected(11) = True 'Reducció participacions entitats amb vincle laboral If PARMS(12, 1) <> 0 Then ListBox135.Selected(100 - (PARMS(12, 1) * 100)) = True Else ListBox135.Selected(11) = True 'Reducció explotacions agràries If PARMS(12, 2) <> 0 Then ListBox136.Selected(95 - (PARMS(12, 2) * 100)) = True Else ListBox136.Selected(11) = True If PARMS(12, 3) <> 0 Then ListBox137.Selected(90 - (PARMS(12, 3) * 100)) = True Else ListBox137.Selected(11) = True If PARMS(12, 4) <> 0 Then ListBox138.Selected(80 - (PARMS(12, 4) * 100)) = True Else ListBox138.Selected(11) = True If PARMS(12, 5) <> 0 Then ListBox139.Selected(55 - (PARMS(12, 5) * 100)) = True Else ListBox139.Selected(11) = True If PARMS(12, 6) <> 0 Then ListBox1310.Selected(100 - (PARMS(12, 6) * 100)) = True Else ListBox1310.Selected(11) = True If PARMS(13, 1) <> 0 Then ListBox1311.Selected(100 - (PARMS(13, 1) * 100)) = True Else ListBox1311.Selected(11) = True 'Reducció finques rústiques de dedicació forestal If PARMS(14, 1) <> 0 Then ListBox1312.Selected(100 - (PARMS(14, 1) * 100)) = True Else ListBox1312.Selected(11) = True 'Reducció béns de patrimoni cultural If PARMS(15, 1) <> 0 Then ListBox1313.Selected(100 - (PARMS(15, 1) * 100)) = True Else ListBox1313.Selected(11) = True 'Reducció béns de patrimoni natural If PARMS(15, 2) <> 0 Then ListBox1314.Selected(100 - (PARMS(15, 2) * 100)) = True Else ListBox1314.Selected(11) = True 'Reducció altres If PARMS(16, 1) <> 0 Then ListBox1315.Selected(100 - (PARMS(16, 1) * 100)) = True Else ListBox1315.Selected(11) = True 'Reducció assegurances sobre la vida TextBox1315.Value = PARMS(16, 2) If PARMS(17, 1) <> 0 Then ListBox1316.Selected(100 - (PARMS(17, 1) * 100)) = True Else ListBox1316.Selected(11) = True 'Reducció habitatge TextBox1316.Value = PARMS(17, 2) ElseIf MultiPage1.Value = 1 Then Me.Caption = "SIMCAT-IS: Tarifa" & " (Base de dades: " & ANOIS & " )" For Each CTL In Frame21.Controls For i1 = 1 To 4 For j1 = 1 To 4 If CTL.Name = "TextBox21" & i1 & j1 Then CTL.Text = Format(PARMS(17 + i1, j1), "0.0000") Next j1 Next i1 Next CTL ListBox22.Selected(16 - PARMS(0, 2)) = True For Each CTL In Frame222.Controls For i1 = 1 To PARMS(0, 2) If CTL.Name = "TextBox222" & i1 & "2" Then CTL.Text = PARMS(21 + i1, 2) If CTL.Name = "TextBox222" & i1 & "3" Then CTL.Text = Format(PARMS(21 + i1, 3) * 100, "#0.00") Next i1 Next CTL ListBox23.Selected(16 - PARMS(0, 3)) = True For Each CTL In Frame232.Controls For i1 = 1 To IS_NTRAMS If CTL.Name = "TextBox232" & i1 & "2" Then CTL.Text = PARMS(21 + i1, 6) If CTL.Name = "TextBox232" & i1 & "3" Then CTL.Text = Format(PARMS(21 + i1, 7) * 100, "#0.00") Next i1 Next CTL End If End Sub Private Sub Cancelar_Click() SORTIR = True IMPOST(2) = True Unload Me End Sub Private Sub ListBox22_Click() Dim i1 As Integer NTRAMS12 = ListBox22.Value For Each CTL In Frame221.Controls If CTL.TabIndex <= NTRAMS12 - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame222.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMS12 - 1 If CTL.TabIndex = 3 * i1 + 1 Or CTL.TabIndex = 3 * i1 + 2 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox222" & NTRAMS12 & "2" Then CTL.Enabled = False CTL.Value = "i més" End If Next CTL For Each CTL In Frame223.Controls If CTL.TabIndex <= NTRAMS12 - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL TextBox22211.Value = "0" End Sub Private Sub ListBox23_Click() Dim i1 As Integer NTRAMS34 = ListBox23.Value For Each CTL In Frame231.Controls If CTL.TabIndex <= NTRAMS34 - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame232.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMS34 - 1 If CTL.TabIndex = 3 * i1 + 1 Or CTL.TabIndex = 3 * i1 + 2 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox232" & NTRAMS34 & "2" Then CTL.Enabled = False CTL.Value = "i més" End If Next CTL For Each CTL In Frame233.Controls If CTL.TabIndex <= NTRAMS34 - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL TextBox23211.Value = "0" End Sub Private Sub ListBox241_Click() Dim i1 As Integer NTRAMS_BON_IS = ListBox241.Value For Each CTL In Frame242.Controls If CTL.TabIndex <= NTRAMS_BON_IS - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame243.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMS_BON_IS - 1 If CTL.TabIndex = 3 * i1 + 1 Or CTL.TabIndex = 3 * i1 + 2 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox24311" Then CTL.Enabled = False CTL.Value = "0" End If If CTL.Name = "TextBox243" & NTRAMS_BON_IS & "2" Then CTL.Enabled = False CTL.Value = "En endavant" End If Next CTL For Each CTL In Frame244.Controls If CTL.TabIndex <= NTRAMS_BON_IS - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL End Sub Private Sub ListBox245_Click() PER_BON_REDS = ListBox245.Value / 50 End Sub Private Sub Llei_Click() Dim i1 As Integer, j1 As Integer If MultiPage1.Value = 0 Then For i1 = 1 To 7 'Reducció parentiu For Each CTL In Frame11.Controls If CTL.Name = "TextBox11" & i1 Then CTL.Value = IS_R301(i1, 1) Next CTL Next i1 TextBox1111.Value = IS_R301(1, 2) TextBox1112.Value = IS_R301(1, 3) TextBox1211.Value = IS_R302(1) 'Reducció minusvalidesa TextBox1212.Value = IS_R302(2) ListBox122.Selected(80 - IS_R303(1)) = True 'Reducció edat TextBox1221.Value = IS_R303(2) ListBox131.Selected(100 - (IS_R306(1) * 100)) = True 'Reducció empresa individual o negoci professional ListBox132.Selected(100 - (IS_R307(1) * 100)) = True 'Reducció participacions entitats ListBox133.Selected(100 - (IS_R307(2) * 100)) = True 'Reducció participacions societats laborals ListBox134.Selected(100 - (IS_R307(3) * 100)) = True 'Reducció participacions entitats amb vincle laboral ListBox135.Selected(100 - (IS_R310(1) * 100)) = True 'Reducció explotacions agràries ListBox136.Selected(95 - (IS_R310(2) * 100)) = True ListBox137.Selected(90 - (IS_R310(3) * 100)) = True ListBox138.Selected(80 - (IS_R310(4) * 100)) = True ListBox139.Selected(55 - (IS_R310(5) * 100)) = True ListBox1310.Selected(100 - (IS_R310(6) * 100)) = True ListBox1311.Selected(100 - (IS_R309(1) * 100)) = True 'Reducció finques rústiques de dedicació forestal ListBox1312.Selected(100 - (IS_R311(1) * 100)) = True 'Reducció béns de patrimoni cultural ListBox1313.Selected(100 - (IS_R312(1) * 100)) = True 'Reducció béns de patrimoni natural ListBox1314.Selected(100 - (IS_R312(1) * 100)) = True 'Reducció altres ListBox1315.Selected(100 - (IS_R305(1) * 100)) = True 'Reducció assegurances sobre la vida TextBox1315.Value = IS_R305(2) ListBox1316.Selected(100 - (IS_R308(1) * 100)) = True 'Reducció habitatge TextBox1316.Value = IS_R308(2) ElseIf MultiPage1.Value = 1 Then For Each CTL In Frame21.Controls For i1 = 1 To 4 If i1 <> 2 Then For j1 = 1 To 4 If CTL.Name = "TextBox21" & i1 & j1 Then CTL.Text = Format(IS_COEF(i1, j1), "0.0000") Next j1 End If Next i1 Next CTL ListBox22.Selected(16 - IS_NTRAMS) = True For Each CTL In Frame222.Controls For i1 = 1 To IS_NTRAMS If i1 <> IS_NTRAMS And CTL.Name = "TextBox222" & i1 & "2" Then CTL.Text = IS_TRAMS(i1) If CTL.Name = "TextBox222" & i1 & "3" Then CTL.Text = Format(IS_TIPUS(i1) * 100, "#0.00") Next i1 Next CTL ListBox23.Selected(16 - IS_NTRAMS) = True For Each CTL In Frame232.Controls For i1 = 1 To IS_NTRAMS If i1 <> IS_NTRAMS And CTL.Name = "TextBox232" & i1 & "2" Then CTL.Text = IS_TRAMS(i1) If CTL.Name = "TextBox232" & i1 & "3" Then CTL.Text = Format(IS_TIPUS(i1) * 100, "#0.00") Next i1 Next CTL ElseIf MultiPage1.Value = 2 Then TextBox24.Value = Format(IS_BON(0, 2) * 100, "#0.00") ListBox241.Selected(12 - IS_NTRAMS_BON) = True For Each CTL In Frame243.Controls For i1 = 1 To IS_NTRAMS_BON If i1 <> IS_NTRAMS_BON And CTL.Name = "TextBox243" & i1 & "2" Then CTL.Text = IS_BON(i1, 1) If CTL.Name = "TextBox243" & i1 & "3" Then CTL.Text = Format(IS_BON(i1, 2) * 100, "#0.00") Next i1 If CTL.Name = "TextBox243" & IS_NTRAMS_BON & 2 Then CTL.Value = "En endavant" Next CTL TextBox24311.Value = 0# ListBox245.Selected(50) = True End If End Sub Private Sub ListBox_Simulref_Click() Dim i1 As Integer, j1 As Integer, nsim As Integer, p(51, 10) For i1 = 0 To ISIMULS(2) - 1 If ListBox_SimulRef.Selected(i1) = True Then nsim = ListBox_SimulRef.Value Exit For End If Next i1 Call COMUNS_1REFERENCIA_SIMULS("IS", nsim, p) If MultiPage1.Value = 0 Then For i1 = 1 To 7 'Reducció parentiu For Each CTL In Frame11.Controls If CTL.Name = "TextBox11" & i1 Then CTL.Value = Format(p(i1, 1), "#0") Next CTL Next i1 TextBox1111.Value = Format(p(1, 2), "#0") TextBox1112.Value = Format(p(1, 3), "#0") TextBox1211.Value = p(8, 1) 'Reducció minusvalidesa TextBox1212.Value = p(8, 2) ListBox122.Selected(80 - p(9, 1)) = True 'Reducció edat TextBox1221.Value = p(9, 2) If p(10, 1) <> 0 Then ListBox131.Selected(100 - (p(10, 1) * 100)) = True Else ListBox131.Selected(11) = True 'Reducció empresa individual o negoci professional If p(11, 1) <> 0 Then ListBox132.Selected(100 - (p(11, 1) * 100)) = True Else ListBox132.Selected(11) = True 'Reducció participacions entitats If p(11, 2) <> 0 Then ListBox133.Selected(100 - (p(11, 2) * 100)) = True Else ListBox133.Selected(11) = True 'Reducció participacions societats laborals If p(11, 3) <> 0 Then ListBox134.Selected(100 - (p(11, 3) * 100)) = True Else ListBox134.Selected(11) = True 'Reducció participacions entitats amb vincle laboral If p(12, 1) <> 0 Then ListBox135.Selected(100 - (p(12, 1) * 100)) = True Else ListBox135.Selected(11) = True 'Reducció explotacions agràries If p(12, 2) <> 0 Then ListBox136.Selected(95 - (p(12, 2) * 100)) = True Else ListBox136.Selected(11) = True If p(12, 3) <> 0 Then ListBox137.Selected(90 - (p(12, 3) * 100)) = True Else ListBox137.Selected(11) = True If p(12, 4) <> 0 Then ListBox138.Selected(80 - (p(12, 4) * 100)) = True Else ListBox138.Selected(11) = True If p(12, 5) <> 0 Then ListBox139.Selected(55 - (p(12, 5) * 100)) = True Else ListBox139.Selected(11) = True If p(12, 6) <> 0 Then ListBox1310.Selected(100 - (p(12, 6) * 100)) = True Else ListBox1310.Selected(11) = True If p(13, 1) <> 0 Then ListBox1311.Selected(100 - (p(13, 1) * 100)) = True Else ListBox1311.Selected(11) = True 'Reducció finques rústiques de dedicació forestal If p(14, 1) <> 0 Then ListBox1312.Selected(100 - (p(14, 1) * 100)) = True Else ListBox1312.Selected(11) = True 'Reducció béns de patrimoni cultural If p(15, 1) <> 0 Then ListBox1313.Selected(100 - (p(15, 1) * 100)) = True Else ListBox1313.Selected(11) = True 'Reducció béns de patrimoni natural If p(15, 2) <> 0 Then ListBox1314.Selected(100 - (p(15, 2) * 100)) = True Else ListBox1314.Selected(11) = True 'Reducció altres If p(16, 1) <> 0 Then ListBox1315.Selected(100 - (p(16, 1) * 100)) = True Else ListBox1315.Selected(11) = True 'Reducció assegurances sobre la vida TextBox1315.Value = p(16, 2) If p(17, 1) <> 0 Then ListBox1316.Selected(100 - (p(17, 1) * 100)) = True Else ListBox1316.Selected(11) = True 'Reducció habitatge TextBox1316.Value = p(17, 2) ElseIf MultiPage1.Value = 1 Then For Each CTL In Frame21.Controls For i1 = 1 To 4 For j1 = 1 To 4 If CTL.Name = "TextBox21" & i1 & j1 Then CTL.Value = Format(p(17 + i1, j1), "0.0000") Next j1 Next i1 Next CTL ListBox22.Selected(16 - p(0, 2)) = True For Each CTL In Frame222.Controls For i1 = 1 To p(0, 2) If i1 <> p(0, 2) And CTL.Name = "TextBox222" & i1 & "2" Then CTL.Text = p(21 + i1, 2) If CTL.Name = "TextBox222" & i1 & "3" Then CTL.Text = Format(p(21 + i1, 3) * 100, "#0.00") Next i1 Next CTL ListBox23.Selected(16 - p(0, 3)) = True For Each CTL In Frame232.Controls For i1 = 1 To p(0, 3) If i1 <> p(0, 3) And CTL.Name = "TextBox232" & i1 & "2" Then CTL.Text = p(21 + i1, 6) If CTL.Name = "TextBox232" & i1 & "3" Then CTL.Text = Format(p(21 + i1, 7) * 100, "#0.00") Next i1 Next CTL ElseIf MultiPage1.Value = 2 Then TextBox24.Value = Format(p(38, 4) * 100, "#0.00") ListBox241.Selected(12 - p(0, 4)) = True For Each CTL In Frame243.Controls For i1 = 1 To p(0, 4) If i1 <> p(0, 4) And CTL.Name = "TextBox243" & i1 & "2" Then CTL.Text = p(39 + i1, 2) If CTL.Name = "TextBox243" & i1 & "3" Then CTL.Text = Format(p(38 + i1, 4) * 100, "#0.00") Next i1 If CTL.Name = "TextBox243" & p(0, 4) & 2 Then CTL.Value = "En endavant" Next CTL TextBox24311.Value = "0" ListBox245.Selected(p(51, 1) * 100) = True End If End Sub Private Sub MultiPage1_Layout(ByVal Index As Long) If MultiPage1.Value = 0 Then Aceptar.Left = 227.5 Anterior.Visible = False Cancelar.Left = 277.5 Else Aceptar.Left = 253 Anterior.Visible = True Cancelar.Left = 303 End If End Sub Private Sub NetejaValors_Click() Dim i1 As Integer, j1 As Integer If MultiPage1.Value = 0 Then For i1 = 1 To 7 'Reducció parentiu For Each CTL In Frame11.Controls If CTL.Name = "TextBox11" & i1 Then CTL.Value = "0" Next CTL Next i1 TextBox1111.Value = "0" TextBox1112.Value = "0" TextBox1211.Value = "0" 'Reducció minusvalidesa TextBox1212.Value = "0" ListBox122.Selected(80 - IS_R303(1)) = True 'Reducció edat TextBox1221.Value = "0" ListBox131.Selected(11) = True 'Reducció empresa individual o negoci professional ListBox132.Selected(11) = True 'Reducció participacions entitats ListBox133.Selected(11) = True 'Reducció participacions societats laborals ListBox134.Selected(11) = True 'Reducció participacions entitats amb vincle laboral ListBox135.Selected(11) = True 'Reducció explotacions agràries ListBox136.Selected(11) = True ListBox137.Selected(11) = True ListBox138.Selected(11) = True ListBox139.Selected(11) = True ListBox1310.Selected(11) = True ListBox1311.Selected(11) = True 'Reducció finques rústiques de dedicació forestal ListBox1312.Selected(11) = True 'Reducció béns de patrimoni cultural ListBox1313.Selected(11) = True 'Reducció béns de patrimoni natural ListBox1314.Selected(11) = True 'Reducció altres ListBox1315.Selected(11) = True 'Reducció assegurances sobre la vida TextBox1315.Value = "0" ListBox1316.Selected(11) = True 'Reducció habitatge TextBox1316.Value = "0" ElseIf MultiPage1.Value = 1 Then For Each CTL In Frame21.Controls For i1 = 1 To 4 For j1 = 1 To 4 If CTL.Name = "TextBox21" & i1 & j1 Then CTL.Text = "0.0000" Next j1 Next i1 Next CTL ListBox22.Selected(15) = True ListBox23.Selected(15) = True TextBox22213.Text = 14 TextBox23213.Text = 14 ElseIf MultiPage1.Value = 2 Then ListBox241.Selected(11) = True TextBox24311.Text = "0" TextBox24312.Text = "En endavant" TextBox24313.Text = "50,00" ListBox245.Selected(100) = True End If End Sub Private Sub SimulRef_Change() Dim i1 As Integer If SimulRef Then Frame02.Width = 190 For i1 = 0 To ISIMULS(2) - 1 ListBox_SimulRef.Selected(i1) = False Next i1 Else Frame02.Width = 150 ListBox_SimulRef.TopIndex = 0 End If End Sub Private Sub Textbox22212_Change() If IsNumeric(TextBox22212.Value) Then TextBox22221.Value = TextBox22212.Value End Sub Private Sub Textbox22222_Change() If IsNumeric(TextBox22222.Value) Then TextBox22231.Value = TextBox22222.Value End Sub Private Sub Textbox22232_Change() If IsNumeric(TextBox22232.Value) Then TextBox22241.Value = TextBox22232.Value End Sub Private Sub Textbox22242_Change() If IsNumeric(TextBox22242.Value) Then TextBox22251.Value = TextBox22242.Value End Sub Private Sub Textbox22252_Change() If IsNumeric(TextBox22252.Value) Then TextBox22261.Value = TextBox22252.Value End Sub Private Sub TextBox22262_Change() If IsNumeric(TextBox22262.Value) Then TextBox22271.Value = TextBox22262.Value End Sub Private Sub TextBox22272_Change() If IsNumeric(TextBox22272.Value) Then TextBox22281.Value = TextBox22272.Value End Sub Private Sub TextBox22282_Change() If IsNumeric(TextBox22282.Value) Then TextBox22291.Value = TextBox22282.Value End Sub Private Sub TextBox22292_Change() If IsNumeric(TextBox22292.Value) Then TextBox222101.Value = TextBox22292.Value End Sub Private Sub TextBox222102_Change() If IsNumeric(TextBox222102.Value) Then TextBox222111.Value = TextBox222102.Value End Sub Private Sub TextBox222112_Change() If IsNumeric(TextBox222112.Value) Then TextBox222121.Value = TextBox222112.Value End Sub Private Sub TextBox222122_Change() If IsNumeric(TextBox222122.Value) Then TextBox222131.Value = TextBox222122.Value End Sub Private Sub TextBox222132_Change() If IsNumeric(TextBox222132.Value) Then TextBox222141.Value = TextBox222132.Value End Sub Private Sub TextBox222142_Change() If IsNumeric(TextBox222142.Value) Then TextBox222151.Value = TextBox222142.Value End Sub Private Sub TextBox222152_Change() If IsNumeric(TextBox222152.Value) Then TextBox222161.Value = TextBox222152.Value End Sub Private Sub TextBox23212_Change() If IsNumeric(TextBox23212.Value) Then TextBox23221.Value = TextBox23212.Value End Sub Private Sub TextBox23222_Change() If IsNumeric(TextBox23222.Value) Then TextBox23231.Value = TextBox23222.Value End Sub Private Sub TextBox23232_Change() If IsNumeric(TextBox23232.Value) Then TextBox23241.Value = TextBox23232.Value End Sub Private Sub TextBox23242_Change() If IsNumeric(TextBox23242.Value) Then TextBox23251.Value = TextBox23242.Value End Sub Private Sub TextBox23252_Change() If IsNumeric(TextBox23252.Value) Then TextBox23261.Value = TextBox23252.Value End Sub Private Sub TextBox23262_Change() If IsNumeric(TextBox23262.Value) Then TextBox23271.Value = TextBox23262.Value End Sub Private Sub TextBox23272_Change() If IsNumeric(TextBox23272.Value) Then TextBox23281.Value = TextBox23272.Value End Sub Private Sub TextBox23282_Change() If IsNumeric(TextBox23282.Value) Then TextBox23291.Value = TextBox23282.Value End Sub Private Sub TextBox23292_Change() If IsNumeric(TextBox23292.Value) Then TextBox232101.Value = TextBox23292.Value End Sub Private Sub TextBox232102_Change() If IsNumeric(TextBox232102.Value) Then TextBox232111.Value = TextBox232102.Value End Sub Private Sub TextBox232112_Change() If IsNumeric(TextBox232112.Value) Then TextBox232121.Value = TextBox232112.Value End Sub Private Sub TextBox232122_Change() If IsNumeric(TextBox232122.Value) Then TextBox232131.Value = TextBox232122.Value End Sub Private Sub TextBox232132_Change() If IsNumeric(TextBox232132.Value) Then TextBox232141.Value = TextBox232132.Value End Sub Private Sub TextBox232142_Change() If IsNumeric(TextBox232142.Value) Then TextBox232151.Value = TextBox232142.Value End Sub Private Sub TextBox232152_Change() If IsNumeric(TextBox232152.Value) Then TextBox232161.Value = TextBox232152.Value End Sub Private Sub TextBox24312_Change() If IsNumeric(TextBox24312.Value) Then TextBox24321.Value = TextBox24312.Value End Sub Private Sub TextBox24322_Change() If IsNumeric(TextBox24322.Value) Then TextBox24331.Value = TextBox24322.Value End Sub Private Sub TextBox24332_Change() If IsNumeric(TextBox24332.Value) Then TextBox24341.Value = TextBox24332.Value End Sub Private Sub TextBox24342_Change() If IsNumeric(TextBox24342.Value) Then TextBox24351.Value = TextBox24342.Value End Sub Private Sub TextBox24352_Change() If IsNumeric(TextBox24352.Value) Then TextBox24361.Value = TextBox24352.Value End Sub Private Sub TextBox24362_Change() If IsNumeric(TextBox24362.Value) Then TextBox24371.Value = TextBox24362.Value End Sub Private Sub TextBox24372_Change() If IsNumeric(TextBox24372.Value) Then TextBox24381.Value = TextBox24372.Value End Sub Private Sub TextBox24382_Change() If IsNumeric(TextBox24382.Value) Then TextBox24391.Value = TextBox24382.Value End Sub Private Sub TextBox24392_Change() If IsNumeric(TextBox24392.Value) Then TextBox243101.Value = TextBox24392.Value End Sub Private Sub TextBox243102_Change() If IsNumeric(TextBox243102.Value) Then TextBox243111.Value = TextBox243102.Value End Sub Private Sub TextBox243112_Change() If IsNumeric(TextBox243112.Value) Then TextBox243121.Value = TextBox243112.Value End Sub Private Sub UserForm_Activate() height1 = Me.Height left1 = Me.Left top1 = Me.Top width1 = Me.Width If ISIMULS(2) <> 0 Then Frame02.Width = 150 Else Frame02.Width = 104 End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then SORTIR = True Unload Me End Sub Private Sub UserForm_Zoom(Percent As Integer) 'Me.Width = Me.Width * Percent / 100 'Me.Height = Me.Height * Percent / 100 'Me.Left = left1 - ((Me.Width - width1) / 2) 'Me.Top = top1 - ((Me.Width - width1) / 2) End Sub VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} IS2 Caption = "ID" ClientHeight = 8070 ClientLeft = 48 ClientTop = 456 ClientWidth = 10848 OleObjectBlob = "IS2.frx":0000 StartUpPosition = 1 'Centrar en propietario End Attribute VB_Name = "IS2" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim height1 As Integer, left1 As Integer, top1 As Integer, width1 As Integer Private Sub Aceptar_Click() Dim i1 As Integer, j1 As Integer ERR_LEC = False If MultiPage1.Value = 0 Then ReDim R_BASE(1 To 15, 1 To 3) 'Reduccions a la base R_BASE(1, 1) = ListBox11.Value / 100 'Empresa individual o negoci professional (AR) R_BASE(2, 1) = ListBox12.Value / 100 'Participacions en entitats (PR) R_BASE(3, 1) = ListBox13.Value / 100 'Participacions en societats laborals (LR) R_BASE(4, 1) = ListBox14.Value / 100 'Participacions en entitats amb vincle laboral (VR) R_BASE(5, 1) = ListBox15.Value / 100 'Quantitats adquisició empresa o participacions (NR) R_BASE(6, 1) = ListBox16.Value / 100 'Patrimoni històric o cultural (HR) R_BASE(7, 1) = ListBox17.Value / 100 'Immoble destinat habitatge habitual (HB) R_BASE(8, 1) = ListBox18.Value / 100 'Quantitats adquisició habitatge habitual (DB) R_BASE(9, 1) = ListBox19.Value / 100 'Aportacions patrimonis protegits (MR) R_BASE(10, 1) = ListBox110.Value / 100 'Explotacions agràries (EA) R_BASE(11, 1) = ListBox111.Value / 100 'Explotacions agràries (EB) R_BASE(12, 1) = ListBox112.Value / 100 'Explotacions agràries (EC) R_BASE(13, 1) = ListBox113.Value / 100 'Explotacions agràries (ED) R_BASE(14, 1) = ListBox114.Value / 100 'Explotacions agràries (EF) R_BASE(15, 1) = ListBox115.Value / 100 'Altres (RR) If Not IsNumeric(TextBox151.Value) Or Val(TextBox151.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el límit general de la reducció 'Quantitats adquisició empresa o participacions'.", vbCritical, TITOL_ID Exit Sub Else R_BASE(5, 2) = Val(Replace(TextBox151.Value, ",", ".")) End If If Not IsNumeric(TextBox152.Value) Or Val(TextBox152.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el límit (discapacitats) de la reducció 'Quantitats adquisició empresa o participacions'.", vbCritical, TITOL_ID Exit Sub Else R_BASE(5, 3) = Val(Replace(TextBox152.Value, ",", ".")) End If If Not IsNumeric(TextBox171.Value) Or Val(TextBox171.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el límit general de la reducció 'Immoble destinat habitatge habitual'.", vbCritical, TITOL_ID Exit Sub Else R_BASE(7, 2) = Val(Replace(TextBox171.Value, ",", ".")) End If If Not IsNumeric(TextBox172.Value) Or Val(TextBox172.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el límit (discapacitats) de la reducció 'Immoble destinat habitatge habitual'.", vbCritical, TITOL_ID Exit Sub Else R_BASE(7, 3) = Val(Replace(TextBox172.Value, ",", ".")) End If If Not IsNumeric(TextBox181.Value) Or Val(TextBox181.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el límit general de la reducció 'Quantitats adquisició habitatge habitual'.", vbCritical, TITOL_ID Exit Sub Else R_BASE(8, 2) = Val(Replace(TextBox181.Value, ",", ".")) End If If Not IsNumeric(TextBox182.Value) Or Val(TextBox182.Value) < 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el límit (discapacitats) de la reducció 'Quantitats adquisició habitatge habitual'.", vbCritical, TITOL_ID Exit Sub Else R_BASE(8, 3) = Val(Replace(TextBox182.Value, ",", ".")) End If ReDim PARMS(36, 6) 'Guarda els paràmetres del primer quadre a PARMS' PARMS(0, 0) = "Paràmetres" PARMS(0, 1) = ID_ANYREF For i1 = 1 To 15 PARMS(i1, 1) = R_BASE(i1, 1) If i1 = 5 Or i1 = 7 Or i1 = 8 Then For j1 = 2 To 3 PARMS(i1, j1) = R_BASE(i1, j1) Next j1 End If Next i1 ElseIf MultiPage1.Value = 1 Then ReDim COEF(1 To 4, 1 To 4) For i1 = 1 To 4 If i1 <> 2 Then For j1 = 1 To 4 For Each CTL In Frame21.Controls If CTL.Name = "TextBox21" & i1 & j1 Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el coeficient multiplicador" & i1 & "," & j1 & ".", vbCritical, TITOL_IS Exit Sub Else COEF(i1, j1) = Val(Replace(CTL.Value, ",", ".")) End If End If Next CTL Next j1 End If For j1 = 1 To 4 COEF(2, j1) = COEF(1, j1) Next j1 Next i1 NTRAMS12 = ListBox22.Value 'Trams i tipus grups 1 i 2 ReDim TIPUS12(1 To NTRAMS12), T12(1 To NTRAMS12) For i1 = 1 To NTRAMS12 For Each CTL In Frame222.Controls If i1 <> NTRAMS12 Then If CTL.Name = "TextBox222" & i1 & "2" Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " de la tarifa dels Grups 1 i 2.", vbCritical, TITOL_ID Exit Sub Else T12(i1) = Val(Replace(CTL.Value, ",", ".")) End If End If End If If CTL.Name = "TextBox222" & i1 & "3" Then If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu del TRAM " & i1 & " dels Grups 1 i 2.", vbCritical, TITOL_ID Exit Sub Else TIPUS12(i1) = Val(Replace(CTL.Value, ",", ".")) / 100 End If End If Next CTL If i1 <> 1 Then If i1 <> NTRAMS12 Then If T12(i1) <= T12(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " de la tarifa dels Grups 1 i 2.", vbCritical, TITOL_ID Exit Sub End If End If If TIPUS12(i1) < TIPUS12(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu del TRAM " & i1 & " dels Grups 1 i 2.", vbCritical, TITOL_ID Exit Sub End If End If Next i1 NTRAMS34 = ListBox23.Value 'Trams i tipus grups 3 i 4 ReDim TIPUS34(1 To NTRAMS34), T34(1 To NTRAMS34) For i1 = 1 To NTRAMS34 For Each CTL In Frame232.Controls If i1 <> NTRAMS34 Then If CTL.Name = "TextBox232" & i1 & "2" Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " de la tarifa dels Grups 3 i 4.", vbCritical, TITOL_ID Exit Sub Else T34(i1) = Val(Replace(CTL.Value, ",", ".")) End If End If End If If CTL.Name = "TextBox232" & i1 & "3" Then If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu del TRAM " & i1 & " del Grups 3 i 4.", vbCritical, TITOL_ID Exit Sub Else TIPUS34(i1) = Val(Replace(CTL.Value, ",", ".")) / 100 End If End If Next CTL If i1 <> 1 Then If i1 <> NTRAMS34 Then If T34(i1) <= T34(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " de la tarifa dels Grups 3 i 4.", vbCritical, TITOL_ID Exit Sub End If End If If TIPUS34(i1) < TIPUS34(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu del TRAM " & i1 & " dels Grups 3 i 4.", vbCritical, TITOL_ID Exit Sub End If End If Next i1 ReDim BON_ID(1 To 4) BON_ID(1) = Val(ListBox241.Value) / 100 BON_ID(2) = Val(ListBox241.Value) / 100 BON_ID(3) = Val(ListBox243.Value) / 100 BON_ID(4) = Val(ListBox244.Value) / 100 PARMS(0, 2) = NTRAMS12 'Guarda els paràmetres del segon quadre a PARMS' PARMS(0, 3) = NTRAMS34 For i1 = 1 To 4 For j1 = 1 To 4 PARMS(15 + i1, j1) = COEF(i1, j1) Next j1 Next i1 For i1 = 1 To NTRAMS12 If i1 = 1 Then PARMS(19 + i1, 1) = "0" PARMS(19 + i1, 2) = IIf(i1 <> NTRAMS12, T12(i1), "i més") PARMS(19 + i1, 3) = TIPUS12(i1) + 0.0000000001 ElseIf i1 < NTRAMS12 Then PARMS(19 + i1, 1) = T12(i1 - 1) PARMS(19 + i1, 2) = T12(i1) PARMS(19 + i1, 3) = TIPUS12(i1) + 0.0000000001 Else PARMS(19 + i1, 1) = T12(i1 - 1) PARMS(19 + i1, 2) = "i més" PARMS(19 + i1, 3) = TIPUS12(i1) + 0.0000000001 End If Next i1 For i1 = 1 To NTRAMS34 If i1 = 1 Then PARMS(19 + i1, 4) = "0" PARMS(19 + i1, 5) = IIf(i1 <> NTRAMS34, T34(i1), "i més") PARMS(19 + i1, 6) = TIPUS34(i1) + 0.0000000001 ElseIf i1 < NTRAMS34 Then PARMS(19 + i1, 4) = T34(i1 - 1) PARMS(19 + i1, 5) = T34(i1) PARMS(19 + i1, 6) = TIPUS34(i1) + 0.0000000001 Else PARMS(19 + i1, 4) = T34(i1 - 1) PARMS(19 + i1, 5) = "i més" PARMS(19 + i1, 6) = TIPUS34(i1) + 0.0000000001 End If Next i1 For j1 = 1 To 4 PARMS(36, j1) = BON_ID(j1) Next j1 End If Unload Me End Sub Private Sub Anterior_Click() Dim i1 As Integer, j1 As Integer PAGINA = PAGINA - 1 MultiPage1.Value = PAGINA Me.Caption = "SIMCAT-ID: Reduccions a la Base Imposable" & " (Base de dades: " & ANOID & " )" NetejaValors.Value = False SimulRef.Value = False ListBox11.Selected(100 - PARMS(1, 1) * 100) = True ListBox12.Selected(100 - PARMS(2, 1) * 100) = True ListBox13.Selected(100 - PARMS(3, 1) * 100) = True ListBox14.Selected(100 - PARMS(4, 1) * 100) = True ListBox15.Selected(100 - PARMS(5, 1) * 100) = True ListBox16.Selected(100 - PARMS(6, 1) * 100) = True ListBox17.Selected(100 - PARMS(7, 1) * 100) = True ListBox18.Selected(100 - PARMS(8, 1) * 100) = True ListBox19.Selected(100 - PARMS(9, 1) * 100) = True ListBox110.Selected(100 - PARMS(10, 1) * 100) = True ListBox111.Selected(100 - PARMS(11, 1) * 100) = True ListBox112.Selected(100 - PARMS(12, 1) * 100) = True ListBox113.Selected(100 - PARMS(13, 1) * 100) = True ListBox114.Selected(100 - PARMS(14, 1) * 100) = True ListBox115.Selected(100 - PARMS(15, 1) * 100) = True TextBox151.Value = PARMS(5, 2) TextBox152.Value = PARMS(5, 3) TextBox171.Value = PARMS(7, 2) TextBox172.Value = PARMS(7, 3) TextBox181.Value = PARMS(8, 2) TextBox182.Value = PARMS(8, 3) End Sub Private Sub Cancelar_Click() SORTIR = True IMPOST(3) = True Unload Me End Sub Private Sub ListBox22_Click() Dim i1 As Integer NTRAMS12 = ListBox22.Value For Each CTL In Frame231.Controls If CTL.TabIndex <= NTRAMS12 - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame222.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMS12 - 1 If CTL.TabIndex = 3 * i1 + 1 Or CTL.TabIndex = 3 * i1 + 2 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox222" & NTRAMS12 & "2" Then CTL.Enabled = False CTL.Value = "i més" End If Next CTL For Each CTL In Frame223.Controls If CTL.TabIndex <= NTRAMS12 - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL TextBox22211.Value = "0" End Sub Private Sub ListBox23_Click() Dim i1 As Integer NTRAMS34 = ListBox23.Value For Each CTL In Frame231.Controls If CTL.TabIndex <= NTRAMS34 - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame232.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMS34 - 1 If CTL.TabIndex = 3 * i1 + 1 Or CTL.TabIndex = 3 * i1 + 2 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox232" & NTRAMS34 & "2" Then CTL.Enabled = False CTL.Value = "i més" End If Next CTL For Each CTL In Frame233.Controls If CTL.TabIndex <= NTRAMS34 - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL TextBox23211.Value = "0" End Sub Private Sub Llei_Click() Dim i1 As Integer, j1 As Integer If MultiPage1.Value = 0 Then ListBox11.Selected(100 - (ID_R_BASE(1, 1) * 100)) = True ListBox12.Selected(100 - (ID_R_BASE(2, 1) * 100)) = True ListBox13.Selected(100 - (ID_R_BASE(3, 1) * 100)) = True ListBox14.Selected(100 - (ID_R_BASE(4, 1) * 100)) = True ListBox15.Selected(100 - (ID_R_BASE(5, 1) * 100)) = True ListBox16.Selected(100 - (ID_R_BASE(6, 1) * 100)) = True ListBox17.Selected(100 - (ID_R_BASE(7, 1) * 100)) = True ListBox18.Selected(100 - (ID_R_BASE(8, 1) * 100)) = True ListBox19.Selected(100 - (ID_R_BASE(9, 1) * 100)) = True ListBox110.Selected(100 - (ID_R_BASE(10, 1) * 100)) = True ListBox111.Selected(100 - (ID_R_BASE(11, 1) * 100)) = True ListBox112.Selected(100 - (ID_R_BASE(12, 1) * 100)) = True ListBox113.Selected(100 - (ID_R_BASE(13, 1) * 100)) = True ListBox114.Selected(100 - (ID_R_BASE(14, 1) * 100)) = True ListBox115.Selected(100 - (ID_R_BASE(15, 1) * 100)) = True TextBox151.Value = ID_R_BASE(5, 2) TextBox152.Value = ID_R_BASE(5, 3) TextBox171.Value = ID_R_BASE(7, 2) TextBox172.Value = ID_R_BASE(7, 3) TextBox181.Value = ID_R_BASE(8, 2) TextBox182.Value = ID_R_BASE(8, 3) ElseIf MultiPage1.Value = 1 Then For Each CTL In Frame21.Controls For i1 = 1 To 4 If i1 <> 2 Then For j1 = 1 To 4 If CTL.Name = "TextBox21" & i1 & j1 Then CTL.Text = Format(ID_COEF(i1, j1), "0.0000") Next j1 End If Next i1 Next CTL ListBox22.Selected(16 - ID_NTRAMS12) = True For Each CTL In Frame222.Controls For i1 = 1 To ID_NTRAMS12 If i1 <> ID_NTRAMS12 And CTL.Name = "TextBox222" & i1 & "2" Then CTL.Text = ID_TRAMS12(i1) If CTL.Name = "TextBox222" & i1 & "3" Then CTL.Text = Format(ID_TIPUS12(i1) * 100, "#0.00") Next i1 Next CTL ListBox23.Selected(16 - ID_NTRAMS34) = True For Each CTL In Frame232.Controls For i1 = 1 To ID_NTRAMS34 If i1 <> ID_NTRAMS34 And CTL.Name = "TextBox232" & i1 & "2" Then CTL.Text = ID_TRAMS34(i1) If CTL.Name = "TextBox232" & i1 & "3" Then CTL.Text = Format(ID_TIPUS34(i1) * 100, "#0.00") Next i1 Next CTL ListBox241.Selected(100) = True ListBox243.Selected(100) = True ListBox244.Selected(100) = True End If End Sub Private Sub ListBox_Simulref_Click() Dim i1 As Integer, j1 As Integer, nsim As Integer, p(36, 6) For i1 = 0 To ISIMULS(3) - 1 If ListBox_SimulRef.Selected(i1) = True Then nsim = ListBox_SimulRef.Value Exit For End If Next i1 Call COMUNS_1REFERENCIA_SIMULS("ID", nsim, p) If MultiPage1.Value = 0 Then ListBox11.Selected(100 - p(1, 1) * 100) = True ListBox12.Selected(100 - p(2, 1) * 100) = True ListBox13.Selected(100 - p(3, 1) * 100) = True ListBox14.Selected(100 - p(4, 1) * 100) = True ListBox15.Selected(100 - p(5, 1) * 100) = True ListBox16.Selected(100 - p(6, 1) * 100) = True ListBox17.Selected(100 - p(7, 1) * 100) = True ListBox18.Selected(100 - p(8, 1) * 100) = True ListBox19.Selected(100 - p(9, 1) * 100) = True ListBox110.Selected(100 - p(10, 1) * 100) = True ListBox111.Selected(100 - p(11, 1) * 100) = True ListBox112.Selected(100 - p(12, 1) * 100) = True ListBox113.Selected(100 - p(13, 1) * 100) = True ListBox114.Selected(100 - p(14, 1) * 100) = True ListBox115.Selected(100 - p(15, 1) * 100) = True TextBox151.Value = p(5, 2) TextBox152.Value = p(5, 3) TextBox171.Value = p(7, 2) TextBox172.Value = p(7, 3) TextBox181.Value = p(8, 2) TextBox182.Value = p(8, 3) ElseIf MultiPage1.Value = 1 Then For Each CTL In Frame21.Controls For i1 = 1 To 4 For j1 = 1 To 4 If CTL.Name = "TextBox21" & i1 & j1 Then CTL.Value = Format(p(15 + i1, j1), "0.0000") Next j1 Next i1 Next CTL ListBox22.Selected(16 - p(0, 2)) = True For Each CTL In Frame222.Controls For i1 = 1 To p(0, 2) If i1 <> p(0, 2) And CTL.Name = "TextBox222" & i1 & "2" Then CTL.Text = p(19 + i1, 2) If CTL.Name = "TextBox222" & i1 & "3" Then CTL.Text = Format(p(19 + i1, 3) * 100, "#0.00") Next i1 Next CTL ListBox23.Selected(16 - p(0, 3)) = True For Each CTL In Frame232.Controls For i1 = 1 To p(0, 3) If i1 <> p(0, 3) And CTL.Name = "TextBox232" & i1 & "2" Then CTL.Text = p(19 + i1, 5) If CTL.Name = "TextBox232" & i1 & "3" Then CTL.Text = Format(p(19 + i1, 6) * 100, "#0.00") Next i1 Next CTL ListBox241.Selected(100 - p(36, 1) * 100) = True ListBox243.Selected(100 - p(36, 3) * 100) = True ListBox244.Selected(100 - p(36, 4) * 100) = True End If End Sub Private Sub MultiPage1_Layout(ByVal Index As Long) If MultiPage1.Value = 0 Then Aceptar.Left = 223 Anterior.Visible = False Cancelar.Left = 273 Else Aceptar.Left = 248 Anterior.Visible = True Cancelar.Left = 298 End If End Sub Private Sub NetejaValors_Click() Dim i1 As Integer, j1 As Integer If MultiPage1.Value = 0 Then ListBox11.Selected(100) = True ListBox12.Selected(100) = True ListBox13.Selected(100) = True ListBox14.Selected(100) = True ListBox15.Selected(100) = True ListBox16.Selected(100) = True ListBox17.Selected(100) = True ListBox18.Selected(100) = True ListBox19.Selected(100) = True ListBox110.Selected(100) = True ListBox111.Selected(100) = True ListBox112.Selected(100) = True ListBox113.Selected(100) = True ListBox114.Selected(100) = True ListBox115.Selected(100) = True TextBox151.Value = "0" TextBox152.Value = "0" TextBox171.Value = "0" TextBox172.Value = "0" TextBox181.Value = "0" TextBox182.Value = "0" ElseIf MultiPage1.Value = 1 Then For Each CTL In Frame21.Controls For i1 = 1 To 4 For j1 = 1 To 4 If CTL.Name = "TextBox21" & i1 & j1 Then CTL.Text = "0.0000" Next j1 Next i1 Next CTL ListBox22.Selected(15) = True ListBox23.Selected(15) = True TextBox22213.Text = 14 TextBox23213.Text = 14 ListBox241.Selected(100) = True ListBox243.Selected(100) = True ListBox244.Selected(100) = True End If End Sub Private Sub SimulRef_Change() Dim i1 As Integer If SimulRef Then Frame02.Width = 190 For i1 = 0 To ISIMULS(3) - 1 ListBox_SimulRef.Selected(i1) = False Next i1 Else Frame02.Width = 150 ListBox_SimulRef.TopIndex = 0 End If End Sub Private Sub Textbox22212_Change() If IsNumeric(TextBox22212.Value) Then TextBox22221.Value = TextBox22212.Value End Sub Private Sub Textbox22222_Change() If IsNumeric(TextBox22222.Value) Then TextBox22231.Value = TextBox22222.Value End Sub Private Sub Textbox22232_Change() If IsNumeric(TextBox22232.Value) Then TextBox22241.Value = TextBox22232.Value End Sub Private Sub Textbox22242_Change() If IsNumeric(TextBox22242.Value) Then TextBox22251.Value = TextBox22242.Value End Sub Private Sub Textbox22252_Change() If IsNumeric(TextBox22252.Value) Then TextBox22261.Value = TextBox22252.Value End Sub Private Sub TextBox22262_Change() If IsNumeric(TextBox22262.Value) Then TextBox22271.Value = TextBox22262.Value End Sub Private Sub TextBox22272_Change() If IsNumeric(TextBox22272.Value) Then TextBox22281.Value = TextBox22272.Value End Sub Private Sub TextBox22282_Change() If IsNumeric(TextBox22282.Value) Then TextBox22291.Value = TextBox22282.Value End Sub Private Sub TextBox22292_Change() If IsNumeric(TextBox22292.Value) Then TextBox222101.Value = TextBox22292.Value End Sub Private Sub TextBox222102_Change() If IsNumeric(TextBox222102.Value) Then TextBox222111.Value = TextBox222102.Value End Sub Private Sub TextBox222112_Change() If IsNumeric(TextBox222112.Value) Then TextBox222121.Value = TextBox222112.Value End Sub Private Sub TextBox222122_Change() If IsNumeric(TextBox222122.Value) Then TextBox222131.Value = TextBox222122.Value End Sub Private Sub TextBox222132_Change() If IsNumeric(TextBox222132.Value) Then TextBox222141.Value = TextBox222132.Value End Sub Private Sub TextBox222142_Change() If IsNumeric(TextBox222142.Value) Then TextBox222151.Value = TextBox222142.Value End Sub Private Sub TextBox222152_Change() If IsNumeric(TextBox222152.Value) Then TextBox222161.Value = TextBox222152.Value End Sub Private Sub TextBox23212_Change() If IsNumeric(TextBox23212.Value) Then TextBox23221.Value = TextBox23212.Value End Sub Private Sub TextBox23222_Change() If IsNumeric(TextBox23222.Value) Then TextBox23231.Value = TextBox23222.Value End Sub Private Sub TextBox23232_Change() If IsNumeric(TextBox23232.Value) Then TextBox23241.Value = TextBox23232.Value End Sub Private Sub TextBox23242_Change() If IsNumeric(TextBox23242.Value) Then TextBox23251.Value = TextBox23242.Value End Sub Private Sub TextBox23252_Change() If IsNumeric(TextBox23252.Value) Then TextBox23261.Value = TextBox23252.Value End Sub Private Sub TextBox23262_Change() If IsNumeric(TextBox23262.Value) Then TextBox23271.Value = TextBox23262.Value End Sub Private Sub TextBox23272_Change() If IsNumeric(TextBox23272.Value) Then TextBox23281.Value = TextBox23272.Value End Sub Private Sub TextBox23282_Change() If IsNumeric(TextBox23282.Value) Then TextBox23291.Value = TextBox23282.Value End Sub Private Sub TextBox23292_Change() If IsNumeric(TextBox23292.Value) Then TextBox232101.Value = TextBox23292.Value End Sub Private Sub TextBox232102_Change() If IsNumeric(TextBox232102.Value) Then TextBox232111.Value = TextBox232102.Value End Sub Private Sub TextBox232112_Change() If IsNumeric(TextBox232112.Value) Then TextBox232121.Value = TextBox232112.Value End Sub Private Sub TextBox232122_Change() If IsNumeric(TextBox232122.Value) Then TextBox232131.Value = TextBox232122.Value End Sub Private Sub TextBox232132_Change() If IsNumeric(TextBox232132.Value) Then TextBox232141.Value = TextBox232132.Value End Sub Private Sub TextBox232142_Change() If IsNumeric(TextBox232142.Value) Then TextBox232151.Value = TextBox232142.Value End Sub Private Sub TextBox232152_Change() If IsNumeric(TextBox232152.Value) Then TextBox232161.Value = TextBox232152.Value End Sub Private Sub UserForm_Activate() height1 = Me.Height left1 = Me.Left top1 = Me.Top width1 = Me.Width If ISIMULS(3) <> 0 Then Frame02.Width = 150 Else Frame02.Width = 104 End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then SORTIR = True Unload Me End Sub Private Sub UserForm_Zoom(Percent As Integer) 'Me.Width = Me.Width * Percent / 100 'Me.Height = Me.Height * Percent / 100 'Me.Left = left1 - ((Me.Width - width1) / 2) 'Me.Top = top1 - ((Me.Width - width1) / 2) End Sub VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ITPOAJDOS Caption = "ITPOAJDOS" ClientHeight = 7176 ClientLeft = 36 ClientTop = 468 ClientWidth = 10824 OleObjectBlob = "ITPOAJDOS.frx":0000 StartUpPosition = 1 'Centrar en propietario End Attribute VB_Name = "ITPOAJDOS" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim height1 As Integer, left1 As Integer, top1 As Integer, width1 As Integer Private Sub Aceptar_Click() Dim i1 As Integer, j1 As Integer ERR_LEC = False NTRAMSTUB = ListBox111.Value ReDim TIPUSTUB(1 To NTRAMSTUB), TRAMSTUB(1 To NTRAMSTUB) 'Trams i tipus Tarifes TUB, TRT, TV0 For i1 = 1 To NTRAMSTUB For Each CTL In Frame1112.Controls If i1 <> NTRAMSTUB Then If CTL.Name = "TextBox1112" & i1 & "2" Then If Not IsNumeric(CTL.Value) Or Val(CTL.Value) <= 0 Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " de la base de les Tarifes TUB, TRT i TV0.", vbCritical, TITOL_IT Exit Sub Else TRAMSTUB(i1) = Val(Replace(CTL.Value, ",", ".")) End If End If End If If CTL.Name = "TextBox1112" & i1 & 3 Then CTL.Value = Replace(CTL.Value, ",", ".") If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus del TRAM " & i1 & " de la base de les Tarifes TUB, TRT, TV0.", vbCritical, TITOL_IT Exit Sub Else TIPUSTUB(i1) = Val(CTL.Value) / 100 End If End If Next CTL If i1 <> 1 Then If i1 <> NTRAMSTUB Then If TRAMSTUB(i1) <= TRAMSTUB(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el TRAM " & i1 & " de la base de l'estalvi.", vbCritical, TITOL_IT Exit Sub End If End If If TIPUSTUB(i1) < TIPUSTUB(i1 - 1) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus del TRAM " & i1 & " de la base de les Tarifes TUB, TRT i TV0.", vbCritical, TITOL_IT Exit Sub End If End If Next i1 ReDim TIPUS_TPO(1 To 17) TIPUS_TPO(1) = 0.1: TIPUS_TPO(2) = 0.1: TIPUS_TPO(3) = 0.1 For Each CTL In Frame112.Controls For i1 = 4 To 17 If CTL.Name = "TextBox1122" & i1 Then If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu de la Tarifa " & IT_TARIFA_TPO(i1) & ".", vbCritical, TITOL_IT Exit Sub Else TIPUS_TPO(i1) = Val(Replace(CTL.Value, ",", ".")) / 100 End If End If Next i1 Next CTL BON_IT_TUB = Val(ListBox_TUB.Value) / 100 PROJ(1) = 1 + (ListBox_TPO.Value / 100) ReDim TIPUS_OS(1 To 7) For Each CTL In Frame122.Controls For i1 = 1 To 7 If CTL.Name = "TextBox122" & i1 Then If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu de la Tarifa " & IT_TARIFA_OS(i1) & ".", vbCritical, TITOL_IT Exit Sub Else TIPUS_OS(i1) = Val(Replace(CTL.Value, ",", ".")) / 100 End If End If Next i1 Next CTL PROJ(2) = 1 + (ListBox_OS.Value / 100) ReDim TIPUS_AJD(1 To 17) For Each CTL In Frame132.Controls For i1 = 1 To 17 If CTL.Name = "TextBox132" & i1 Then If Not IsNumeric(CTL.Value) Or (Val(CTL.Value) < 0 Or Val(CTL.Value) >= 100) Then ERR_LEC = True Me.Hide MsgBox "Error en el tipus impositiu de la Tarifa " & IT_TARIFA_AJD(i1) & ".", vbCritical, TITOL_IT Exit Sub Else TIPUS_AJD(i1) = Val(Replace(CTL.Value, ",", ".")) / 100 End If End If Next i1 Next CTL PROJ(3) = 1 + (ListBox_AJD.Value / 100) ReDim PARMS(20 + NTRAMSTUB, 6) 'Guarda els paràmetres a PARMS' PARMS(0, 1) = IT_ANYREF PARMS(0, 2) = NTRAMSTUB For i1 = 4 To 17 PARMS(i1, 1) = IT_TARIFA_TPO(i1) PARMS(i1, 2) = TIPUS_TPO(i1) Next i1 PARMS(18, 1) = "BON_TUB" PARMS(18, 2) = BON_IT_TUB PARMS(19, 1) = PROJ(1) For i1 = 1 To 7 PARMS(i1, 3) = IT_TARIFA_OS(i1) PARMS(i1, 4) = TIPUS_OS(i1) Next i1 PARMS(19, 2) = PROJ(2) For i1 = 1 To 17 PARMS(i1, 5) = IT_TARIFA_AJD(i1) PARMS(i1, 6) = TIPUS_AJD(i1) Next i1 PARMS(19, 3) = PROJ(3) For i1 = 1 To NTRAMSTUB If i1 = 1 Then PARMS(19 + i1, 1) = "0" PARMS(19 + i1, 2) = IIf(i1 <> NTRAMSTUB, TRAMSTUB(i1), "i més") PARMS(19 + i1, 3) = TIPUSTUB(i1) ElseIf i1 < NTRAMSTUB Then PARMS(19 + i1, 1) = TRAMSTUB(i1 - 1) PARMS(19 + i1, 2) = TRAMSTUB(i1) PARMS(19 + i1, 3) = TIPUSTUB(i1) Else PARMS(19 + i1, 1) = TRAMSTUB(i1 - 1) PARMS(19 + i1, 2) = "i més" PARMS(19 + i1, 3) = TIPUSTUB(i1) End If Next i1 Unload Me End Sub Private Sub Cancelar_Click() SORTIR = True IMPOST(4) = True Unload Me End Sub Private Sub ListBox111_Click() Dim i1 As Integer NTRAMSTUB = ListBox111.Value For Each CTL In Frame1111.Controls If CTL.TabIndex <= NTRAMSTUB - 1 Then CTL.Enabled = True Else CTL.Enabled = False Next CTL For Each CTL In Frame1112.Controls CTL.Enabled = False CTL.Value = "" For i1 = 0 To NTRAMSTUB - 1 If CTL.TabIndex = 3 * i1 + 1 Or CTL.TabIndex = 3 * i1 + 2 Then CTL.Enabled = True Next i1 If CTL.Name = "TextBox1112" & NTRAMSTUB & "2" Then CTL.Enabled = False CTL.Value = IIf(NTRAMSTUB > 1, "i més", "màxim") End If Next CTL For Each CTL In Frame1113.Controls If CTL.TabIndex <= NTRAMSTUB Then CTL.Enabled = True Else CTL.Enabled = False Next CTL TextBox111211.Value = "0" End Sub Private Sub ListBox_Simulref_Click() Dim i1 As Integer, j1 As Integer, nsim As Integer, p(19, 6) For i1 = 0 To ISIMULS(4) - 1 If ListBox_SimulRef.Selected(i1) = True Then nsim = ListBox_SimulRef.Value Exit For End If Next i1 Call COMUNS_1REFERENCIA_SIMULS("IT", nsim, p) For Each CTL In Frame112.Controls For i1 = 1 To 17 If CTL.Name = "TextBox112" & i1 Then CTL.Text = Format(p(i1, 2) * 100, "#0.00") Next i1 Next CTL ListBox_TUB.Selected(100 - (p(18, 2) * 100)) = True ListBox_TPO.Selected(500 - ((p(19, 1) - 1) * 1000)) = True For Each CTL In Frame122.Controls For i1 = 1 To 7 If CTL.Name = "TextBox122" & i1 Then CTL.Text = Format(p(i1, 4) * 100, "#0.00") Next i1 Next CTL ListBox_OS.Selected(500 - ((p(19, 2) - 1) * 1000)) = True For Each CTL In Frame132.Controls For i1 = 1 To 17 If CTL.Name = "TextBox132" & i1 Then CTL.Text = Format(p(i1, 6) * 100, "#0.00") Next i1 Next CTL ListBox_AJD.Selected(500 - ((p(19, 3) - 1) * 1000)) = True End Sub Private Sub EmplenaValors_Click() Dim i1 As Integer ListBox111.Selected(5 - IT_NTRAMSTUB) = True For Each CTL In Frame1112.Controls For i1 = 1 To IT_NTRAMSTUB If i1 <> IT_NTRAMSTUB And CTL.Name = "TextBox1112" & i1 & "2" Then CTL.Text = IT_TRAMSTUB(i1) If CTL.Name = "TextBox1112" & i1 & "3" Then CTL.Text = Format(IT_TIPUSTUB(i1) * 100, "#0.00") Next i1 Next CTL For Each CTL In Frame1122.Controls For i1 = 4 To 17 If CTL.Name = "TextBox1122" & i1 Then CTL.Text = Format(IT_TIPUS_TPO(i1) * 100, "#0.00") Next i1 Next CTL ListBox_TUB.Selected(100 - (IT_BON_TUB * 100)) = True ListBox_TPO.Selected(500) = True For Each CTL In Frame122.Controls For i1 = 1 To 7 If CTL.Name = "TextBox122" & i1 Then CTL.Text = Format(IT_TIPUS_OS(i1) * 100, "#0.00") Next i1 Next CTL ListBox_OS.Selected(500) = True For Each CTL In Frame132.Controls For i1 = 1 To 17 If CTL.Name = "TextBox132" & i1 Then CTL.Text = Format(IT_TIPUS_AJD(i1) * 100, "#0.00") Next i1 Next CTL ListBox_AJD.Selected(500) = True End Sub Private Sub NetejaValors_Click() Dim i1 As Integer For Each CTL In Frame112.Controls For i1 = 1 To 17 If CTL.Name = "TextBox112" & i1 Then CTL.Text = Format(1, "#0.00") Next i1 Next CTL ListBox_TPO.Selected(500) = True For Each CTL In Frame122.Controls For i1 = 1 To 7 If CTL.Name = "TextBox122" & i1 Then CTL.Text = Format(1, "#0.00") Next i1 Next CTL ListBox_OS.Selected(500) = True For Each CTL In Frame132.Controls For i1 = 1 To 17 If CTL.Name = "TextBox132" & i1 Then CTL.Text = Format(1, "#0.00") Next i1 Next CTL ListBox_AJD.Selected(500) = True End Sub Private Sub SimulRef_Change() Dim i1 As Integer If SimulRef Then Frame02.Width = 190 For i1 = 0 To ISIMULS(4) - 1 ListBox_SimulRef.Selected(i1) = False Next i1 Else Frame02.Width = 150 ListBox_SimulRef.TopIndex = 0 End If End Sub Private Sub TextBox111212_Change() If IsNumeric(TextBox111212.Value) Then TextBox111221.Value = TextBox111212.Value End Sub Private Sub TextBox111222_Change() If IsNumeric(TextBox111222.Value) Then TextBox111231.Value = TextBox111222.Value End Sub Private Sub TextBox111232_Change() If IsNumeric(TextBox111232.Value) Then TextBox111241.Value = TextBox111232.Value End Sub Private Sub TextBox111242_Change() If IsNumeric(TextBox111242.Value) Then TextBox111251.Value = TextBox111242.Value End Sub Private Sub UserForm_Activate() height1 = Me.Height left1 = Me.Left top1 = Me.Top width1 = Me.Width If ISIMULS(4) <> 0 Then Frame02.Width = 150 Else Frame02.Width = 104 End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then SORTIR = True Unload Me End Sub Private Sub UserForm_Zoom(Percent As Integer) Me.Width = Me.Width * Percent / 100 Me.Height = Me.Height * Percent / 100 Me.Left = left1 - ((Me.Width - width1) / 2) Me.Top = top1 - ((Me.Width - width1) / 2) End Sub VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} SIMCAN_Caratula ClientHeight = 4716 ClientLeft = 48 ClientTop = 336 ClientWidth = 5040 OleObjectBlob = "SIMCAN_Caratula.frx":0000 StartUpPosition = 1 'Centrar en propietario End Attribute VB_Name = "SIMCAN_Caratula" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim height1 As Integer, left1 As Integer, top1 As Integer, width1 As Integer Private Sub Acceptar_Click() Unload Me End Sub Private Sub Credits_Click() Me.MultiPage1.Value = 1 If Application.Wait(Now + TimeValue("0:00:04")) Then Me.MultiPage1.Value = 0 End Sub Private Sub Cancelar_Click() SORTIR = True Unload Me End Sub Private Sub UserForm_Activate() height1 = Me.Height left1 = Me.Left top1 = Me.Top width1 = Me.Width End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then SORTIR = True Unload Me End Sub Private Sub UserForm_Zoom(Percent As Integer) Me.Width = Me.Width * Percent / 100 Me.Height = Me.Height * Percent / 100 Me.Left = left1 - ((Me.Width - width1) / 2) End Sub SIMCAN v1.0. Código fuente SIMCAN v1.0. Código fuente 2 2