un bloc heteròclit

Aquest arxiu Excel ha estat realitzat amb un pur interès lúdic i, de ser possible, per estalviar-se algun euro en la factura del telèfon mòbil. Ja fa temps que el vaig acabar i no li he fet gaire cas, però pensava que potser algú en busqui un de semblant per Internet i el pugui aprofitar.

Les funcionalitats que estan previstes en aquest arxiu són les següents:
Creació de tarifes diferents i anàlisi dels resultats mitjançant gràfiques.
Estudi de diferents escenaris d'ús dels serveis de telefonia mòbil i resultats econòmics segons cada tarifa.
L'arxiu Excel es pot descarregar aquí.
FULL "Paràmetres"

    Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)
         
        ''Disabling events
        Application.EnableEvents = False
        
        ''Disabling screen update
        Application.ScreenUpdating = False
        
        ''Unprotecting the current workbook
        ThisWorkbook.Unprotect Password:="password"
        
        ''Unprotecting the current worksheet
        Worksheets("Paràmetres").Unprotect Password:="password"
        
        ''If there's multi selection
        If Selection.Cells.Count > 1 Then
        
            ''A warning message is thrown
            MsgBox "No pots seleccionar més d'una cel·la alhora.", vbExclamation
            
            ''The last action is unded
            Application.Undo
            
            ''Going to exit label
            GoTo ExitLabel
        End If
            
        ''Declaring variables
        Dim rateCells, currentCell As Range
        Dim i As Integer
        
        ''Setting the range of rate name cells
        Set rateCells = Worksheets("Paràmetres").Range("C2:I2")
        
        ''Setting the color of selected range
        rateCells.Cells.Interior.Color = RGB(196, 215, 155)
        
        ''If the rate doesn't have any name, throws a warning message
        If (Target.Cells.Interior.ColorIndex = 2) And (Target.Value <> 0) Then
            MsgBox "Primer hauràs de posar-li nom a la tarifa.", vbExclamation
            
            ''Cleaning the contents of last cell updated
            Target.ClearContents
            
            ''Going to exit label
            GoTo ExitLabel
        End If
        
        ''
        If Not (Target.row = 2) Then
        
            ''If the cell contains a no numeric value or is not proper written
            If Not (IsNumeric(Target.Value)) Or (InStr(Target.Value, ".")) Then
            
                ''Checking the row of current cell to send proper warning message
                If (Target.row = 8) Or (Target.row = 11) Or (Target.row = 13) Then
                    MsgBox "El valor numèric ha de ser un nombre Natural." & vbNewLine & "Exemple: 8.", vbExclamation
                Else
                    MsgBox "El valor ha de ser un nombre Real positiu." & vbNewLine & "Exemple: 0,08.", vbExclamation
                End If
                
                ''Cleaning the contents of last cell updated
                Target.ClearContents
            End If
        End If
        
        ''Checking if the current value needs to be an integer
        If (Target.row = 8) Or (Target.row = 11) Or (Target.row = 13) Then
        
            ''If the numeric value is not an integer
            If Not ((Target.Value - Int(Target.Value)) = 0) Then
            
                ''A warning message is thrown and value is cleared
                MsgBox "El valor numèric ha de ser un nombre Natural." & vbNewLine & "Exemple: 8.", vbExclamation
                
                ''Cleaning the contents of last cell updated
                Target.ClearContents
            End If
        End If
        
        ''Showing cells to fill up
        For Each currentCell In rateCells
        
            ''Declaring and initializing temp variables
            Dim noBonoTrue As Boolean
            Dim bonoTrue As Boolean
            noBonoTrue = False
            bonoTrue = False
            
            ''Checking if there's data in bono area and no bono area at the same time
            For i = 1 To 16
            
                ''If current cell is not empty
                If Not (IsEmpty(currentCell.Cells.Offset(i, 0))) Then
                
                    ''Checking if current cell data refers to bono or no bono, and updating propoer boolean
                    If ((1 <= i) And (i <= 4)) Then
                        noBonoTrue = True
                    ElseIf ((5 <= i) And (i <= 16)) Then
                        bonoTrue = True
                    End If
                End If
            Next i
            
            ''If both booleans are true
            If ((noBonoTrue = True) And (bonoTrue = True)) Then
            
                ''Throwing a warning message
                MsgBox "No es poden posar valors en la secció 'sense bono' i 'amb bono' alhora." & vbNewLine & _
                            "Hauràs d'esborrar totes les dades de la tarifa abans d'omplir l'altra secció.", vbExclamation
                            
                ''Cleaning the contents of last cell updated
                Target.ClearContents
                
                ''Going to exit label
                GoTo ExitLabel
            End If
            
            ''Checking if there's any limit in the calls number
            If Not (IsEmpty(currentCell.Cells.Offset(6, 0))) And (IsEmpty(currentCell.Cells.Offset(13, 0))) Then
            
                ''Throwing a warning message
                MsgBox "Hi ha un límit de minuts fixat i no hi ha el preu del minut extra." & vbNewLine & _
                            "Això significa que no es podrà trucar un cop consumits els minuts" & vbNewLine & _
                            "del bono. Es posarà el valor '-1' per representar aquest cas." & vbNewLine & _
                            "Hauràs de tenir en compte la representació que això tindrà al gràfic.", vbExclamation
                            
                ''Setting the cell value to -1
                currentCell.Cells.Offset(13, 0).Value = -1
                
            End If
            
            ''Checking if there's any limit in the SMS
            If Not (IsEmpty(currentCell.Cells.Offset(9, 0))) And (IsEmpty(currentCell.Cells.Offset(15, 0))) Then
            
                ''Throwing a warning message
                MsgBox "Hi ha un límit de SMS fixat i no hi ha el preu del SMS extra." & vbNewLine & _
                            "Això significa que no es podrà enviar cap SMS un cop exhaurits" & vbNewLine & _
                            "els SMS del bono. Es posarà el valor '-1' per representar aquest cas." & vbNewLine & _
                            "Hauràs de tenir en compte la representació que això tindrà al gràfic.", vbExclamation
                            
                ''Setting the cell value to -1
                currentCell.Cells.Offset(15, 0).Value = -1
                
            End If
            
            ''Checking if there's any limit in the Internet connection
            If Not (IsEmpty(currentCell.Cells.Offset(11, 0))) And (IsEmpty(currentCell.Cells.Offset(16, 0))) Then
            
                ''Throwing a warning message
                MsgBox "Hi ha un límit de MB fixat i no hi ha el preu de la MB extra." & vbNewLine & _
                            "Això significa que no es podrà consumir cap MB un cop exhaurides" & vbNewLine & _
                            "les MB del bono. Es posarà el valor '-1' per representar aquest cas." & vbNewLine & _
                            "Hauràs de tenir en compte la representació que això tindrà al gràfic.", vbExclamation
                            
                ''Setting the cell value to -1
                currentCell.Cells.Offset(16, 0).Value = -1
                
            End If
            
            ''If currentCellAddress is no empty
            If Not (IsEmpty(currentCell)) Then
            
                ''Iterating the offseted cells corresponding at no bonus case
                For i = 1 To 4
                
                    ''Setting proper color depending on the case, empty or not empty
                    If Not (IsEmpty(currentCell.Cells.Offset(i, 0))) And Not (currentCell.Cells.Offset(i, 0) = 0) Then
                        currentCell.Cells.Offset(i, 0).Interior.ColorIndex = 17
                    Else
                        currentCell.Cells.Offset(i, 0).Interior.ColorIndex = 40
                        currentCell.Cells.Offset(i, 0).ClearContents
                    End If
                Next i
                
                ''Iterating the offseted cells corresponding at bonus case
                For i = 5 To 16
                
                    ''Setting proper color depending on the case, empty or not empty
                    If Not (IsEmpty(currentCell.Cells.Offset(i, 0))) And Not (currentCell.Cells.Offset(i, 0) = 0) Then
                        currentCell.Cells.Offset(i, 0).Interior.ColorIndex = 37
                    Else
                        currentCell.Cells.Offset(i, 0).Interior.ColorIndex = 36
                        currentCell.Cells.Offset(i, 0).ClearContents
                    End If
                Next i
                
                ''Iterating the last 2 offseted cells
                For i = 17 To 18
                
                    ''Setting proper color depending on the case, empty or not empty
                    If Not (IsEmpty(currentCell.Cells.Offset(i, 0))) And Not (currentCell.Cells.Offset(i, 0) = 0) Then
                        currentCell.Cells.Offset(i, 0).Interior.ColorIndex = 20
                    Else
                        currentCell.Cells.Offset(i, 0).Interior.ColorIndex = 19
                        currentCell.Cells.Offset(i, 0).ClearContents
                    End If
                Next i
                
            ''Else, if currentCellAddress is empty
            Else
            
                ''Setting cells to white
                For i = 1 To 18
                    currentCell.Cells.Offset(i, 0).Interior.ColorIndex = 2
                    
                    ''If the cell is not empty
                    If Not (IsEmpty(currentCell.Cells.Offset(i, 0))) Then
                    
                        ''A warning message is thrown
                        MsgBox "No pots enganxar cap valor perquè no has definit el nom de la tarifa.", vbExclamation
                        
                        ''The cell contents is cleared
                        currentCell.Cells.Offset(i, 0).ClearContents
                    End If
                Next i
            End If
        Next
        
        ''Calling 'chartMB' function to create a new chart
        Call chartMB
        
        ''Calling 'chartSMS' function to create a new chart
        Call chartSMS
        
        ''Calling 'chartPhoneCalls' function to create a new chart
        Call chartPhoneCalls

    ''Exit label
    ExitLabel:
        
        ''Protecting the current worksheet
        Worksheets("Paràmetres").Protect Password:="password"
        
        ''Protecting the current workbook
        ThisWorkbook.Protect Password:="password", Structure:=True
        
        ''Enabling events
        Application.EnableEvents = True
        
        ''Enabling screen update
        Application.ScreenUpdating = True

    End Sub

    
FULL "Escenaris"

    Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)
         
        ''Disabling events
        Application.EnableEvents = False
        
        ''Disabling screen update
        Application.ScreenUpdating = False
        
        ''Unprotecting the current workbook
        ThisWorkbook.Unprotect Password:="password"
        
        ''Unprotecting the current worksheet
        Worksheets("Escenaris").Unprotect Password:="password"
           
        ''Calculate worksheet
        Calculate
        
        ''Protecting the current worksheet
        Worksheets("Escenaris").Protect Password:="password"
            
        ''Protecting the current workbook
        ThisWorkbook.Protect Password:="password", Structure:=True
        
        ''Enabling events
        Application.EnableEvents = True
        
        ''Enabling screen update
        Application.ScreenUpdating = True
        
    End Sub

    
MÒDUL1  

    Option Explicit

    Function costTarifa(companyCell As Range, callsNumber As Integer, callsTotalMinuts As Integer, _
                            numSMS As Integer, numMB As Integer)
                            
        ''declaring variables
        Dim callMinuteCostNoBono As Double
        Dim establishedCallCostNoBono As Double
        Dim SMSCostNoBono As Double
        Dim MBCostNoBono As Double
        Dim bonoCost As Double
        Dim callMinuteCostBono As Double
        Dim establishedCallCostBono As Double
        Dim SMSCostBono As Double
        Dim MBCostBono As Double
        Dim callExtraMinuteCostBono As Double
        Dim extraEstablishedCallCostBono As Double
        Dim extraSMSCostBono As Double
        Dim extraMBCostBono As Double
        Dim minimumConsumption As Double
        Dim ivaTax As Double
        Dim result As Double
        Dim totalInternetCost As Double
        Dim numMinutesBono As Integer
        Dim numSMSBono As Integer
        Dim numMBBono As Integer
        Dim callLimite As Boolean
        Dim SMSLimite As Boolean
        Dim MBLimite As Boolean
        
        ''Initializing variables
        callMinuteCostNoBono = companyCell.Offset(1, 0).Value
        establishedCallCostNoBono = companyCell.Offset(2, 0).Value
        SMSCostNoBono = companyCell.Offset(3, 0).Value
        MBCostNoBono = companyCell.Offset(4, 0).Value
        bonoCost = companyCell.Offset(5, 0).Value
        numMinutesBono = companyCell.Offset(6, 0).Value
        callMinuteCostBono = companyCell.Offset(7, 0).Value
        establishedCallCostBono = companyCell.Offset(8, 0).Value
        numSMSBono = companyCell.Offset(9, 0).Value
        SMSCostBono = companyCell.Offset(10, 0).Value
        numMBBono = companyCell.Offset(11, 0).Value
        MBCostBono = companyCell.Offset(12, 0).Value
        callExtraMinuteCostBono = companyCell.Offset(13, 0).Value
        extraEstablishedCallCostBono = companyCell.Offset(14, 0).Value
        extraSMSCostBono = companyCell.Offset(15, 0).Value
        extraMBCostBono = companyCell.Offset(16, 0).Value
        minimumConsumption = companyCell.Offset(17, 0).Value
        ivaTax = companyCell.Offset(18, 0).Value
        result = 0
        totalInternetCost = 0
        callLimite = False
        SMSLimite = False
        SMSLimite = False
        
        ''If there's a limit using services, changing the proper value
        ''and setting boolean to true
        If (callExtraMinuteCostBono < 0) Then
            callExtraMinuteCostBono = 0
            callLimite = True
        ElseIf (extraSMSCostBono < 0) Then
            extraSMSCostBono = 0
            SMSLimite = True
        ElseIf (extraMBCostBono < 0) Then
            extraMBCostBono = 0
            MBLimite = True
        End If
        
        ''Calculating the cost of Internet connection
        result = reckonMBCost(MBCostNoBono, numMBBono, MBCostBono, extraMBCostBono, numMB)
        
        ''Adding the cost of SMS
        result = result + reckonSMSCost(SMSCostNoBono, numSMSBono, SMSCostBono, extraSMSCostBono, numSMS)
        
        ''Adding the cost of calls
        result = result + reckonCallingCost(callMinuteCostNoBono, establishedCallCostNoBono, numMinutesBono, _
                                                                callMinuteCostBono, establishedCallCostBono, _
                                                    callExtraMinuteCostBono, extraEstablishedCallCostBono, _
                                                        (callsTotalMinuts * callsNumber), callsNumber)
        
        ''Adding the cost of bonus
        result = result + (bonoCost * (1 + (ivaTax / 100)))
                    
        ''Checking if result is higher than minimum consumption
        If (result < minimumConsumption) Then
            result = minimumConsumption * (1 + (ivaTax / 100))
        End If
        
        ''If there's a limit using services, returning result with a warning message
        If (callLimite) Then
            costTarifa = result & " €" & vbNewLine & "Limitat."
        ElseIf (SMSLimite) And (numSMS > numSMSBono) Then
            costTarifa = result & " €" & vbNewLine & "Limitat."
        ElseIf (MBLimite) And (numMB > numMBBono) Then
            costTarifa = result & " €" & vbNewLine & "Limitat."
        ''If there's no limit, returning the result
        Else
            costTarifa = result
        End If
                        
    End Function
    
    
MÒDUL2

    Option Explicit

    Function reckonSMSCost(SMSCostNoBono As Double, numSMSBono As Integer, _
                            SMSCostBono As Double, extraSMSCostBono As Double, numSMS As Integer) As Double

        ''Declaring and initializing variable
        Dim numSMSNoBono As Integer
        numSMSNoBono = 0
        
        ''Calculating the SMS out of the bono
        If (numSMSBono > 0) Then
            numSMSNoBono = numSMSBono - numSMS
        End If
        
        ''Choosing the case between
        If (SMSCostNoBono > 0) Then
        
            ''If there's no bono
            reckonSMSCost = (numSMS * SMSCostNoBono)
        Else
        
            ''If there's bono
            If (numSMSNoBono >= 0) Then
                reckonSMSCost = (numSMS * SMSCostBono)
            Else
                reckonSMSCost = (numSMSBono * SMSCostBono) + ((-numSMSNoBono) * extraSMSCostBono)
            End If
        End If
    End Function

    Function reckonMBCost(MBCostNoBono, numMBBono, MBCostBono, extraMBCostBono, numMB) As Double

        ''Declaring and initializing variable
        Dim numMBNoBono As Integer
        numMBNoBono = 0
        
        ''Calculating the MB out of the bono
        If (numMBBono > 0) Then
            numMBNoBono = numMBBono - numMB
        End If
        
        ''Choosing the case between
        If (MBCostNoBono > 0) Then
        
            ''If there's no bono
            reckonMBCost = (numMB * MBCostNoBono)
        Else
        
            ''If there's bono
            If (numMBNoBono >= 0) Then
                reckonMBCost = (numMB * MBCostBono)
            Else
                reckonMBCost = (numMBBono * MBCostBono) + ((-numMBNoBono) * extraMBCostBono)
            End If
        End If
    End Function

    Function reckonCallingCost(callMinuteCostNoBono, establishedCallCostNoBono, numMinutesBono, callMinuteCostBono, _
                                    establishedCallCostBono, callExtraMinuteCostBono, extraEstablishedCallCostBono, _
                                    totalCallNumMinutes, numCalls) As Double

        ''Declaring and initializing variables
        Dim numMinutesNoBono As Single
        numMinutesNoBono = 0
        
        ''Calculating the minutes out of the bono
        If (numMinutesBono > 0) Then
            numMinutesNoBono = numMinutesBono - totalCallNumMinutes
        End If
        
        ''Choosing the case between
        If (callMinuteCostNoBono > 0) Then
        
            ''If there's no bono
            reckonCallingCost = (totalCallNumMinutes * callMinuteCostNoBono) + (establishedCallCostNoBono * numCalls)
        Else
        
            ''If there's bono
            If (numMinutesNoBono >= 0) Then
                reckonCallingCost = (totalCallNumMinutes * callMinuteCostBono) + (establishedCallCostBono * numCalls)
            Else
                reckonCallingCost = (numMinutesBono * callMinuteCostBono) + ((-numMinutesNoBono) * callExtraMinuteCostBono) _
                                      + (numCalls * establishedCallCostBono)
            End If
        End If
    End Function


MÒDUL3

    Option Explicit

    Sub chartPhoneCalls()

        ''Declaring and initializating variables
        Dim PhoneCallsSerie As Series
        Dim PhoneCallsNumber(101)
        Dim totalPhoneCallsPrice(101)
        Dim phoneCallsDuration(101)
        Dim i As Single
        Dim j As Single
        Dim k As Single
        Dim PhoneCallMinutePrice As Double
        Dim PhoneCallConnectionPrice As Double
        Dim rateCells As Range
        Dim currentCell As Range
        Dim callMinuteCostNoBono As Double
        Dim establishedCallCostNoBono As Double
        Dim callMinuteCostBono As Double
        Dim establishedCallCostBono As Double
        Dim callExtraMinuteCostBono As Double
        Dim extraEstablishedCallCostBono As Double
        Dim ivaTax As Double
        Dim numMinutesBono As Integer
        Dim legendNumber As Integer
        legendNumber = 0
        
        ''Setting range with rates description of 'Paràmetres' worksheet
        Set rateCells = Worksheets("Paràmetres").Range("C2:I2")
            
        ''Disabling alerts
        Application.DisplayAlerts = False
            
        ''Controlling a possible error
        On Error Resume Next
        Sheets("Anàlisi trucades telefòniques").Delete
        On Error GoTo 0
            
        ''Adding a new chart and setting its parameters
        With Charts.Add
            .ChartType = xlXYScatterSmoothNoMarkers
            .Name = "Anàlisi trucades telefòniques"
            .HasTitle = True
            .ChartTitle.Text = "Anàlisi de consum en trucades telefòniques" & vbCrLf & _
                                "(de duració aleatòria entre 1 i 30 minuts cada trucada)"
            .ChartTitle.Characters(1, 42).Font.Size = 18
            .ChartTitle.Characters(43, 100).Font.Size = 12
            .Move after:=Worksheets(Worksheets.Count)
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Número de trucades efectuades en un mes"
            .Axes(xlCategory, xlPrimary).AxisTitle.Font.Size = 14
            .Axes(xlCategory).HasMajorGridlines = True
            .Axes(xlCategory).MaximumScale = 100
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Cost en Euros (IVA inclòs)" & vbCrLf & _
                                                                    "exceptuant el preu del bono"
            .Axes(xlValue, xlPrimary).AxisTitle.Characters(1, 26).Font.Size = 14
            .Axes(xlValue, xlPrimary).AxisTitle.Characters(27, 100).Font.Size = 11
            .Axes(xlValue).HasMajorGridlines = True
            .Axes(xlValue).MinimumScale = 0
            
            ''Cleaning the chart
            With ActiveChart
                Do Until .SeriesCollection.Count = 0
                    .SeriesCollection(1).Delete
                Loop
            End With
            
            ''Iterating 101 times to get all prices range
            For j = 0 To 100
                
                ''To calculate the duration of the calls, it's calculated the time call
                ''randomly between 1 minut par call (j+1) and 30 minuts par call (30*(j+1))
                'phoneCallsDuration(j) = Int(((10 * (j + 1)) - (j + 1) + (j + 1)) * Rnd + (j + 1))
                phoneCallsDuration(j) = (Int(((30 - 1 + 1) * Rnd) + 1)) * (j)
                If (j > 50) Then
                            phoneCallsDuration(j) = phoneCallsDuration(j)
                        End If
            Next
            
            ''Iterating the 'rateCells'
            For Each currentCell In rateCells
            
                ''If the current item is not empty
                If Not IsEmpty(currentCell) Then
            
                    ''Setting 'SMSSerie' to current
                    Set PhoneCallsSerie = ActiveChart.SeriesCollection.NewSeries
                        
                    ''Initializing variables
                    callMinuteCostNoBono = currentCell.Offset(1, 0).Value
                    establishedCallCostNoBono = currentCell.Offset(2, 0).Value
                    numMinutesBono = currentCell.Offset(6, 0).Value
                    callMinuteCostBono = currentCell.Offset(7, 0).Value
                    establishedCallCostBono = currentCell.Offset(8, 0).Value
                    callExtraMinuteCostBono = currentCell.Offset(13, 0).Value
                    extraEstablishedCallCostBono = currentCell.Offset(14, 0).Value
                    ivaTax = currentCell.Offset(18, 0).Value
                    
                    ''Iterating 101 times to get all prices range
                    For k = 0 To 100
                                    
                        ''Adding items to arrays with data
                        PhoneCallsNumber(k) = k
                        totalPhoneCallsPrice(k) = reckonCallingCost(callMinuteCostNoBono, establishedCallCostNoBono, _
                                                                    numMinutesBono, callMinuteCostBono, establishedCallCostBono, _
                                                                    callExtraMinuteCostBono, extraEstablishedCallCostBono, _
                                                                    phoneCallsDuration(k), k)
                        totalPhoneCallsPrice(k) = ((totalPhoneCallsPrice(k) * ivaTax) / 100) + totalPhoneCallsPrice(k)
                            
                    Next
                    
                    ''Printing out all data to the current serie with random color
                    With PhoneCallsSerie
                        .Name = currentCell.Value
                        .Values = totalPhoneCallsPrice()
                        .XValues = PhoneCallsNumber()
                        .Border.Color = RGB(Int((255 - 1 + 1) * Rnd + 1), (255 - 1 + 1) * Abs(1 - Rnd) + 1, _
                                                (255 - 1 + 1) * Abs(Rnd - 1) + 1)
                        .Trendlines.Add Type:=xlPolynomial
                        With PhoneCallsSerie.Trendlines(1)
                            .Border.ColorIndex = 1
                            .Border.Weight = xlThin
                            .Border.LineStyle = xlContinuous
                        End With
                    End With
                    
                    ''If there's no items in the legend
                    If (legendNumber = 0) Then
                    
                        ''First legend text is added
                        PhoneCallsSerie.Trendlines(1).Name = "Línies de tendència"
                    Else
                    
                        ''Legend textes are set to proper
                        ActiveChart.Legend.LegendEntries(legendNumber + 2).Delete
                        PhoneCallsSerie.Trendlines(1).Name = "Línies de tendència"
                    End If
                    
                    ''Updating counter
                    legendNumber = legendNumber + 1
                End If
            Next
        End With
        
        ''Selecting 'Paràmetres' worksheet
        Worksheets("Paràmetres").Select
        
        ''Enabling alerts
        Application.DisplayAlerts = True
    End Sub


MÒDUL4

    Option Explicit

    Sub chartSMS()

        ''Disabling alerts
        Application.DisplayAlerts = False

        ''Declaring variables
        Dim SMSSerie As Series
        Dim SMSNumber(101)
        Dim totalSMSPrice(101)
        Dim arrayRanges(7)
        Dim i As Integer
        Dim j As Integer
        Dim rateCells As Range
        Dim currentCell As Range
        Dim bonoCost As Double
        Dim SMSCostNoBono As Double
        Dim SMSCostBono As Double
        Dim extraSMSCostBono As Double
        Dim numSMSBono As Integer
        Dim ivaTax As Double
        
        ''
        Set rateCells = Worksheets("Paràmetres").Range("C2:I2")
            
        ''Controlling a possible error
        On Error Resume Next
        Sheets("Anàlisi SMS").Delete
        On Error GoTo 0
            
        ''Adding a new chart and setting its parameters
        With Charts.Add
            .ChartType = xlXYScatterSmoothNoMarkers
            .Name = "Anàlisi SMS"
            .HasTitle = True
            .ChartTitle.Text = "Anàlisi de consum en SMS"
            .Move after:=Worksheets(Worksheets.Count)
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Número de SMS enviats en un mes"
            .Axes(xlCategory, xlPrimary).AxisTitle.Font.Size = 14
            .Axes(xlCategory).HasMajorGridlines = True
            .Axes(xlCategory).MaximumScale = 100
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Cost en Euros (IVA inclòs)" & vbCrLf & _
                                                                    "exceptuant el preu del bono"
            .Axes(xlValue, xlPrimary).AxisTitle.Characters(1, 26).Font.Size = 14
            .Axes(xlValue, xlPrimary).AxisTitle.Characters(27, 100).Font.Size = 11
            .Axes(xlValue).HasMajorGridlines = True
            .Axes(xlValue).MinimumScale = 0
            
            ''Cleaning the chart
            With ActiveChart
                Do Until .SeriesCollection.Count = 0
                    .SeriesCollection(1).Delete
                Loop
            End With
            
            ''Iterating the 'rateCells'
            For Each currentCell In rateCells
            
                ''If the current item is not empty
                If Not IsEmpty(currentCell) Then
            
                    ''Setting 'SMSSerie' to current
                    Set SMSSerie = ActiveChart.SeriesCollection.NewSeries
                        
                    ''Initializing variables
                    bonoCost = currentCell.Offset(5, 0).Value
                    SMSCostNoBono = currentCell.Offset(3, 0).Value
                    numSMSBono = currentCell.Offset(9, 0).Value
                    SMSCostBono = currentCell.Offset(10, 0).Value
                    extraSMSCostBono = currentCell.Offset(15, 0).Value
                    ivaTax = currentCell.Offset(18, 0).Value
                                
                    ''Iterating 101 times to get all prices range
                    For j = 0 To 100
                    
                        ''Adding items to arrays with data
                        SMSNumber(j) = j
                        totalSMSPrice(j) = reckonSMSCost(SMSCostNoBono, numSMSBono, SMSCostBono, extraSMSCostBono, j)
                        totalSMSPrice(j) = ((totalSMSPrice(j) * ivaTax) / 100) + totalSMSPrice(j)
                    Next
                    
                    ''Printing out all data to the current serie with random color
                    With SMSSerie
                        .Name = currentCell.Value
                        .Values = totalSMSPrice()
                        .XValues = SMSNumber()
                        .Border.Color = RGB(Int((255 - 1 + 1) * Rnd + 1), (255 - 1 + 1) * Abs(1 - Rnd) + 1, _
                                                (255 - 1 + 1) * Abs(Rnd - 1) + 1)
                    End With
                End If
            Next
        End With
        
        ''Selecting 'Paràmetres' worksheet
        Worksheets("Paràmetres").Select
        
        ''Enabling alerts
        Application.DisplayAlerts = True
        
    End Sub


MÒDUL5

    Option Explicit

    Sub chartMB()

        ''Disabling alerts
        Application.DisplayAlerts = False

        ''Declaring variables
        Dim MBSerie As Series
        Dim MBNumber(101)
        Dim totalMBPrice(101)
        Dim arrayRanges(7)
        Dim i As Integer
        Dim j As Integer
        Dim rateCells As Range
        Dim currentCell As Range
        Dim bonoCost As Double
        Dim MBCostNoBono As Double
        Dim MBCostBono As Double
        Dim extraMBCostBono As Double
        Dim numMBBono As Integer
        Dim ivaTax As Double
        
        ''Setting range with rates description of 'Paràmetres' worksheet
        Set rateCells = Worksheets("Paràmetres").Range("C2:I2")
            
        ''Controlling a possible error
        On Error Resume Next
        Sheets("Anàlisi Internet (MB)").Delete
        On Error GoTo 0
            
        ''Adding a new chart and setting its parameters
        With Charts.Add
            .ChartType = xlXYScatterSmoothNoMarkers
            .Name = "Anàlisi Internet (MB)"
            .HasTitle = True
            .ChartTitle.Text = "Anàlisi de consum en MB"
            .Move after:=Worksheets(Worksheets.Count)
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Número de MB consumits en un mes"
            .Axes(xlCategory, xlPrimary).AxisTitle.Font.Size = 14
            .Axes(xlCategory).HasMajorGridlines = True
            .Axes(xlCategory).MaximumScale = 1000
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Cost en Euros (IVA inclòs)" & vbCrLf & _
                                                                    "exceptuant el preu del bono"
            .Axes(xlValue, xlPrimary).AxisTitle.Characters(1, 26).Font.Size = 14
            .Axes(xlValue, xlPrimary).AxisTitle.Characters(27, 100).Font.Size = 11
            .Axes(xlValue).HasMajorGridlines = True
            .Axes(xlValue).MinimumScale = 0
            
            ''Cleaning the chart
            With ActiveChart
                Do Until .SeriesCollection.Count = 0
                    .SeriesCollection(1).Delete
                Loop
            End With
            
            ''Iterating the 'rateCells'
            For Each currentCell In rateCells
            
                ''If the current item is not empty
                If Not IsEmpty(currentCell) Then
            
                    ''Setting 'SMSSerie' to current
                    Set MBSerie = ActiveChart.SeriesCollection.NewSeries
                        
                    ''Initializing variables
                    bonoCost = currentCell.Offset(5, 0).Value
                    MBCostNoBono = currentCell.Offset(4, 0).Value
                    numMBBono = currentCell.Offset(11, 0).Value
                    MBCostBono = currentCell.Offset(12, 0).Value
                    extraMBCostBono = currentCell.Offset(16, 0).Value
                    ivaTax = currentCell.Offset(18, 0).Value
                                
                    ''Iterating 101 times to get all prices range
                    For j = 0 To 100
                    
                        ''Adding items to arrays with data
                        MBNumber(j) = j * 10
                        totalMBPrice(j) = reckonMBCost(MBCostNoBono, numMBBono, MBCostBono, extraMBCostBono, j * 10)
                        totalMBPrice(j) = ((totalMBPrice(j) * ivaTax) / 100) + totalMBPrice(j)
                                            
                    Next
                    
                    ''Printing out all data to the current serie with random color
                    With MBSerie
                        .Name = currentCell.Value
                        .Values = totalMBPrice()
                        .XValues = MBNumber()
                        .Border.Color = RGB(Int((255 - 1 + 1) * Rnd + 1), (255 - 1 + 1) * Abs(1 - Rnd) + 1, _
                                                (255 - 1 + 1) * Abs(Rnd - 1) + 1)
                    End With
                End If
            Next
        End With
        
        ''Selecting 'Paràmetres' worksheet
        Worksheets("Paràmetres").Select
        
        ''Enabling alerts
        Application.DisplayAlerts = True
        
    End Sub

    
mòdul6

    Option Explicit

    Sub updateTextBox()

        ''Declaring and initializating variables
        Dim currentCell As Range
        Dim rateCells As Range
        Dim currentCellAddress As Range
        Dim row As String
        Dim column As String
        Dim currentWrittenCell As String
        Dim i As Integer
        Dim j As Integer
        j = 0
        
        ''Setting range with rates description of 'Escenaris' worksheet
        Set rateCells = Worksheets("Paràmetres").Range("C2:I2")
        
        ''Iterating the 'rateCells' range to find all existing rates
        For Each currentCell In rateCells
        
            ''Iterating all rows
            For i = 1 To 6
            
                ''If current rate cell is empty
                If (IsEmpty(currentCell)) Then
                    
                    ''If the evaluated cell is not empty
                    If Not (IsEmpty(Worksheets("Escenaris").Range(currentCell.Address).Offset(i, 1))) Then
                
                        ''Emptying the cell
                        Worksheets("Escenaris").Range(currentCell.Address).Offset(i, 1).ClearContents
                    
                    End If
                End If
            Next i
        Next
        
        ''First stage
        ''Updating values
        Worksheets("Escenaris").TextBox1.Text = Worksheets("Escenaris").Range("L13").Value
        Worksheets("Escenaris").TextBox2.Text = Worksheets("Escenaris").Range("M13").Value
        Worksheets("Escenaris").TextBox3.Text = Worksheets("Escenaris").Range("N13").Value
        Worksheets("Escenaris").TextBox4.Text = Worksheets("Escenaris").Range("O13").Value
            
        ''Second stage
        ''Updating values
        Worksheets("Escenaris").TextBox5.Text = Worksheets("Escenaris").Range("L14").Value
        Worksheets("Escenaris").TextBox6.Text = Worksheets("Escenaris").Range("M14").Value
        Worksheets("Escenaris").TextBox7.Text = Worksheets("Escenaris").Range("N14").Value
        Worksheets("Escenaris").TextBox8.Text = Worksheets("Escenaris").Range("O14").Value
        ''Reckoning new rates values
        
        ''Third stage
        ''Updating values
        Worksheets("Escenaris").TextBox9.Text = Worksheets("Escenaris").Range("L15").Value
        Worksheets("Escenaris").TextBox10.Text = Worksheets("Escenaris").Range("M15").Value
        Worksheets("Escenaris").TextBox11.Text = Worksheets("Escenaris").Range("N15").Value
        Worksheets("Escenaris").TextBox12.Text = Worksheets("Escenaris").Range("O15").Value
        ''Reckoning new rates values
        
        ''Fourth stage
        ''Updating values
        Worksheets("Escenaris").TextBox13.Text = Worksheets("Escenaris").Range("L16").Value
        Worksheets("Escenaris").TextBox14.Text = Worksheets("Escenaris").Range("M16").Value
        Worksheets("Escenaris").TextBox15.Text = Worksheets("Escenaris").Range("N16").Value
        Worksheets("Escenaris").TextBox16.Text = Worksheets("Escenaris").Range("O16").Value
        ''Reckoning new rates values
        
        ''Fifth stage
        ''Updating values
        Worksheets("Escenaris").TextBox17.Text = Worksheets("Escenaris").Range("L17").Value
        Worksheets("Escenaris").TextBox18.Text = Worksheets("Escenaris").Range("M17").Value
        Worksheets("Escenaris").TextBox19.Text = Worksheets("Escenaris").Range("N17").Value
        Worksheets("Escenaris").TextBox20.Text = Worksheets("Escenaris").Range("O17").Value
        ''Reckoning new rates values
        
        ''Sixth stage
        ''Updating values
        Worksheets("Escenaris").TextBox21.Text = Worksheets("Escenaris").Range("L18").Value
        Worksheets("Escenaris").TextBox22.Text = Worksheets("Escenaris").Range("M18").Value
        Worksheets("Escenaris").TextBox23.Text = Worksheets("Escenaris").Range("N18").Value
        Worksheets("Escenaris").TextBox24.Text = Worksheets("Escenaris").Range("O18").Value
        ''Reckoning new rates values
        
        ''Reckoning new rates values
        For Each currentCell In rateCells
        
            ''Iterating the 6 sceneries in column
            For i = 3 To 8
            
                ''If current cell is not empty
                If Not (IsEmpty(currentCell)) Then
                
                    ''Finding the cell's proper position
                    column = ConvertToLetter(currentCell.column + 1)
                    row = i
                    currentWrittenCell = column & row
                           
                    ''Calling the function 'costTarifa' with the proper arguments
                    Worksheets("Escenaris").Range(currentWrittenCell).Value = costTarifa(currentCell, _
                                                                            Worksheets("Escenaris").Range("L1" & i).Value, _
                                                                            Worksheets("Escenaris").Range("M1" & i).Value, _
                                                                            Worksheets("Escenaris").Range("N1" & i).Value, _
                                                                            Worksheets("Escenaris").Range("O1" & i).Value)
                                                                                            
                End If
            Next i
        Next
    End Sub

    
mòdul7

Option Explicit

Function ConvertToLetter(iCol As Integer) As String

    ''Declaring and initializing variables
    Dim iAlpha As Integer
    Dim iRemainder As Integer
    iAlpha = Int(iCol / 27)
    iRemainder = iCol - (iAlpha * 26)
    
    ''Finding first char of column name
    If iAlpha > 0 Then
       ConvertToLetter = Chr(iAlpha + 64)
    End If
    
    ''Finding second char of column name
    If iRemainder > 0 Then
       ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
    End If
    
End Function
un bloc heteròclit

dimecres, 11 de febrer del 2015

Full Excel per comparar diferents tarifes que ofereixen les companyies telefòniques.
