Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1

























Dim ddv() As Integer
Dim s() As Integer

Sub PROJ()
    Dim i As Integer, j As Integer, c As Integer, ca As Integer, n As Integer
    Dim ss(1 To 6, 1 To 8) As Single
    'Ugotovimo, v katerih stolpcih so podatki
    c = Cells(1, 1).Value
    ca = c + 24
    n = Cells(8, c + 11).Value
    If n < 1 Or n > 5 Then
        MsgBox "Predvideli smo samo pet simulacij!", 48, "Opozorilo"
        Exit Sub
    End If
    j = 0
    Do
        j = j + 1
        ss(j, 7) = Cells(j + 11, ca).Value
    Loop Until j = 6
    'Napolnimo prostor v arrayih z vrednostmi
    ss(1, 1) = Cells(ss(1, 7), c).Value
    ss(2, 1) = Cells(ss(2, 7), c).Value
    ss(3, 1) = Cells(ss(3, 7), c).Value
    i = 1
    Do
        i = i + 1
        j = 0
        Do
            j = j + 1
            ss(j, i) = Cells(ss(j, 7), c + i + 11).Value
        Loop Until j = 6
    Loop Until i = 6
    'Pojdimo na list Simulacije in tam popravimo tabele in grafe
    Sheets("Simulacije").Select
    ss(1, 8) = 5
    ss(2, 8) = 32
    ss(3, 8) = 57
    ss(4, 8) = 84
    ss(5, 8) = 111
    ss(6, 8) = 138
    j = 0
    Do
        j = j + 1
        i = 0
        Do
            i = i + 1
            Cells(ss(j, 8) + n, i + 1).Value = ss(j, i)
        Loop Until i = 6
    Loop Until j = 6
    Sheets("Projekcije").Select
End Sub

Sub ADD()
    Dim r As Integer, tip As Integer, c As Integer, ca As Integer, n As Integer, _
        k As Integer, d As Integer, ex3 As Single, rfirst As Integer, rlast As Integer, _
        nrows As Integer, i As Integer, ddvtip As Integer, ddvrow As Integer
    'Ugotovimo, v kateri vrsti se nahajamo
    r = ActiveCell.Row
    'Ugotovimo, v katerih stolpcih so podatki
    c = Cells(1, 1).Value
    ca = c + 23
    'Ali je tu dovoljeno izvajati ta makro?
    tip = Cells(r, ca + 4).Value
    If tip <> 1 And tip <> 3 Then
        MsgBox "Dodajanje na tem mestu ni predvideno!", 48, "Opozorilo"
        Exit Sub
    End If
    ActiveSheet.Unprotect
    'Ugotovimo vrste, ki nas zanimajo
    Do Until Cells(r, ca).Value = tip
        r = r - 1
    Loop
    rfirst = r
    ex3 = 0
    If tip = 3 Then ex3 = -1
    n = Cells(r, ca + 1).Value
    k = Cells(r, ca + 2).Value
    d = Cells(r, ca + 3).Value
    ddvtip = Cells(r, ca + 5).Value
    ddvrow = Cells(r, ca + 6).Value
    ReDim s(1 To n)
    i = 0
    Do
        r = r + 1
        If Cells(r, ca).Value = 2 * tip Then
            i = i + 1
            s(i) = r
        End If
    Loop Until (Cells(r, ca).Value <= tip) And (Cells(r, ca).Value <> 0)
    rlast = r
    'Vrinemo toliko vrst, kot jih je v zadnjem bloku
    nrows = rlast - s(n)
    Rows(rlast & ":" & rlast + nrows - 1).Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown
    'Oznaèimo vrste za kopiranje in jih skopiramo
    Rows(s(n) & ":" & rlast - 1).Select
    Selection.Copy
    Rows(rlast & ":" & rlast + nrows - 1).Select
    ActiveSheet.Paste
    'Popravimo podatke o osnovi
    n = n + 1
    Cells(rfirst, ca + 1).Value = n
    ReDim Preserve s(1 To n)
    s(n) = rlast
    'Popravimo formule v osnovi
    Call NoveFormule(c, n, k, d, rfirst, ex3, ddvtip, ddvrow)
    'Naslednji del je namenjen le dodajanju proizvodov; pozor: kriterij k=7
    If k = 7 Then
        r = rlast
        Do
            r = r + 1
        Loop Until Cells(r, ca) = 7
        r = r + n - 1
        Rows(r & ":" & r).Select
        Application.CutCopyMode = False
        Selection.Insert Shift:=xlDown
        Rows(r - 1 & ":" & r - 1).Select
        Selection.Copy
        Rows(r & ":" & r).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Cells(r, c + 1).FormulaR1C1 = "=R[" & s(n) + 4 - r & "]C/(R31C+R38C+R41C)*100"
        Cells(r, c + 1).Select
                Selection.Copy
        Range(Cells(r, c + 2), Cells(r, c + 17)).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        'Še graf popravimo...
        ActiveSheet.ChartObjects("Chart 14").Activate
        fo = "R" & r & "C" & c + 1 & ":R" & r & "C" & c + 17
        fo = "='Projekcije'!" & fo
        fo = Application.ConvertFormula(Formula:=fo, fromReferenceStyle:=xlR1C1, toReferenceStyle:=xlA1)
        ActiveChart.SeriesCollection.ADD Source:=fo, _
            Rowcol:=xlRows, SeriesLabels:=False, CategoryLabels:=False, Replace:=False
        ActiveChart.SeriesCollection(n + 2).Select
        With ActiveChart.SeriesCollection(n + 2)
            .Name = "=Projekcije!R" & r & "C" & c - 1
        End With
        ActiveWindow.Visible = False
        Cells(s(n), c).Select
    End If
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Sub DEL()
    Dim r As Integer, tip As Integer, c As Integer, ca As Integer, n As Integer, _
        k As Integer, d As Integer, ex3 As Single, rfirst As Integer, rlast As Integer, _
        nrows As Integer, i As Integer, ddvtip As Integer, ddvrow As Integer
    'A si zihr?
    response = MsgBox("Ali zares zbrisem zadnjega izmed blokov?", 36, "Brisanje")
    If response = 7 Then Exit Sub
    'Ugotovimo, v kateri vrsti se nahajamo
    r = ActiveCell.Row
    'Ugotovimo, v katerih stolpcih so podatki
    c = Cells(1, 1).Value
    ca = c + 23
    'Ali je tu dovoljeno izvajati ta makro?
    tip = Cells(r, ca + 4).Value
    If tip <> 1 And tip <> 3 Then
        MsgBox "Brisanje na tem mestu ni predvideno!", 48, "Opozorilo"
        Exit Sub
    End If
    ActiveSheet.Unprotect
    'Ugotovimo vrste, ki nas zanimajo
    Do Until Cells(r, ca).Value = tip
        r = r - 1
    Loop
    rfirst = r
    ex3 = 0
    If tip = 3 Then ex3 = -1
    n = Cells(r, ca + 1).Value
    'Ali je ta primerek zadnji te osnove
    If n = 1 Then
        MsgBox "Brisanje zadnjega preostalega bloka ni dovoljeno!", 48, "Opozorilo"
        Exit Sub
    End If
    k = Cells(r, ca + 2).Value
    d = Cells(r, ca + 3).Value
    ddvtip = Cells(r, ca + 5).Value
    ddvrow = Cells(r, ca + 6).Value
    ReDim s(1 To n)
    i = 0
    Do
        r = r + 1
        If Cells(r, ca).Value = 2 * tip Then
            i = i + 1
            s(i) = r
        End If
    Loop Until (Cells(r, ca).Value <= tip) And (Cells(r, ca).Value <> 0)
    rlast = r
    'Bri[emo zadnjega od blokov
    Rows(s(n) & ":" & rlast - 1).Select
    Selection.Delete Shift:=xlUp
    'Popravimo podatke o osnovi
    n = n - 1
    Cells(rfirst, ca + 1).Value = n
    ReDim Preserve s(1 To n)
    'Popravimo formule v osnovi
    Call NoveFormule(c, n, k, d, rfirst, ex3, ddvtip, ddvrow)
    'Naslednji del je namenjen le brisanju proizvodov; pozor: kriterij k=7
    If k = 7 Then
        r = rfirst
        Do
            r = r + 1
        Loop Until Cells(r, ca) = 7
        r = r + n
        Rows(r & ":" & r).Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.DrawingObjects("Chart 14").Select
        ActiveSheet.ChartObjects("Chart 14").Activate
        ActiveChart.SeriesCollection(n + 3).Select
        Selection.Delete
        ActiveWindow.Visible = False
        Cells(s(n), c).Select
    End If
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Sub NoveFormule(ByVal cs As Integer, ByVal ns As Integer, ByVal ks As Integer, ByVal ds As Integer, ByVal rfirsts As Integer, ByVal ex3s As Single, ByVal ddvtips As Integer, ByVal ddvrows As Integer)
    Dim i As Integer, j As Integer
    i = 0
    If ex3s = -1 Then y1 = Cells(rfirsts, cs + 13).FormulaR1C1
    Do
        i = i + 1
        j = 0
        If i = 1 Then
        Do
            j = j + 1
            Cells(rfirsts + ex3s + j, cs).FormulaR1C1 = "=R[" & (s(i) - (rfirsts + ex3s) - 1) + ds & "]C"
        Loop Until j = ks
        End If
        If i > 1 Then
        Do
            j = j + 1
            Cells(rfirsts + ex3s + j, cs).FormulaR1C1 = Cells(rfirsts + ex3s + j, cs).FormulaR1C1 & "+R[" & (s(i) - (rfirsts + ex3s) - 1) + ds & "]C"
        Loop Until j = ks
        End If
    Loop Until i = ns
    Range(Cells(rfirsts + ex3s + 1, cs), Cells(rfirsts + ex3s + ks, cs)).Select
    Selection.Copy
    Range(Cells(rfirsts + ex3s + 1, cs + 1), Cells(rfirsts + ex3s + ks, cs + 17)).Select
    Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    If ex3s = -1 Then Cells(rfirsts, cs + 13).FormulaR1C1 = y1
    'Popravek formul za izraèun DDV (èe je to v tem bloku ustrezno)
    If ddvtips > 0 Then
        i = 1
        Cells(rfirsts + ddvrows, cs + 1).FormulaR1C1 = "=R[" & (s(i) + ddvtips - 1 - rfirsts - ddvrows) & "]C" & "*R[" & (s(i) + ddvtips - 1 - rfirsts - ddvrows) & "]C" & cs + 18
        If ns > 1 Then
                Do
                i = i + 1
                Cells(rfirsts + ddvrows, cs + 1).FormulaR1C1 = Cells(rfirsts + ddvrows, cs + 1).FormulaR1C1 & "+R[" & (s(i) + ddvtips - 1 - rfirsts - ddvrows) & "]C" & "*R[" & (s(i) + ddvtips - 1 - rfirsts - ddvrows) & "]C" & cs + 18
                Loop Until i = ns
        End If
        Range(Cells(rfirsts + ddvrows, cs + 1), Cells(rfirsts + ddvrows, cs + 1)).Select
        Selection.Copy
        Range(Cells(rfirsts + ddvrows, cs + 2), Cells(rfirsts + ddvrows, cs + 12)).Select
        Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range(Cells(rfirsts + ddvrows, cs + 14), Cells(rfirsts + ddvrows, cs + 17)).Select
        Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    End If
    Cells(s(ns), cs).Select
End Sub

Sub Copyright()
    MsgBox "Projekcije 2007 v2" & String(1, 10) & String(1, 10) & "© 1997-2007 Matic Kovaèiè " & String(1, 10) & "© 1997 prof. dr. Aleš Vahèiè" & String(1, 10) & String(1, 10) & "Ekonomska fakulteta, Ljubljana", 64, "Avtorji"
End Sub