De applicatie bevat de volgende VBA-subroutines:

Module DataInput

Deze module toont het weeknummer voor de in te voeren week en plaatst de data van Forecast View in het werkblad Input als waarden. Als de gebruiker de input beëindigt, volgt er een validatie. Na goedkeuring worden de data overgebracht naar de databases.

Sub FreezeInput()
  answer = MsgBox("Wilt u doorgaan met de ingave?", vbYesNo)
  If answer <> vbYes Then Exit Sub

  Sheets("Forecast View").Visible = False

  Sheets("Input").Select
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  ActiveSheet.Unprotect
  Range("Weeknbr") = Range("InputWkNr")
  Range("WeekNbr").Copy Range("WeekNbr2")

  Range("View1").Copy Range("Start1")
  Range("View2").Copy Range("Start2")
  Range("View3").Copy Range("Start3")
  Range("View4").Copy Range("Start4")
  Range("View5").Copy Range("Start5")

  Range("View7").Copy Range("Start7")
  Range("View8").Copy Range("Start8")
  Range("View9").Copy Range("Start9")
  Range("View10").Copy Range("Start10")
  Range("View11").Copy Range("Start11")

  Range("Input1").Select
  Selection.Locked = False
  Range("Input1").Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("Input2").Select
  Selection.Locked = False
  Range("Input2").Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("Input3").Select
  Selection.Locked = False
  Range("Input3").Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("Input4").Select
  Selection.Locked = False
  Range("Input4").Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("Input5").Select
  Selection.Locked = False
  Range("Input5").Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("Input7").Select
  Selection.Locked = False
  Range("Input7").Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("Input8").Select
  Selection.Locked = False
  Range("Input8").Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("Input9").Select
  Selection.Locked = False
  Range("Input9").Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("Input10").Select
  Selection.Locked = False
  Range("Input10").Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("Input11").Select
  Selection.Locked = False
  Range("Input11").Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("A1").Select
  ActiveSheet.Protect

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  MsgBox ("Doorgaan met data input")

End Sub

Sub TransferInput()
  answer = MsgBox("Wilt u de database met de input bijwerken?", vbYesNo)
  If answer <> vbYes Then Exit Sub

  If Left(Range("Text2"), 2) = "No" Then
     MsgBox ("Geen update vanwege onvolledige week/maand data ")
     Exit Sub
  End If

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  Sheets("Input").Unprotect
  Sheets("Weekly Forecast").Unprotect
  Sheets("Monthly Forecast").Unprotect
  Sheets("Weekly Actuals").Unprotect

  Range("BSweeks").Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Range("InputWeeksFC").Copy
  Sheets("Weekly Forecast").Select
  Range("StartInputWeeklyFC").Select
  ActiveCell.Offset(0, Range("OffsetWeek")).Select
  ActiveSheet.Paste
  Application.CutCopyMode = False

  Sheets("Input").Activate
  Range("BSmonths").Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

  Sheets("MFC").Visible = True
  Range("InputMonthsFC").Copy
  Sheets("MFC").Select
  Range("StartInputMFC").Select
  ActiveCell.Offset(0, Range("OffsetMonth")).Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Sheets("MFC").Visible = False

  Range("InputMonthsFC").Copy
  Sheets("Monthly Forecast").Select
  Range("StartInputMonthlyFC").Select
  ActiveCell.Offset(0, Range("OffsetMonth")).Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Range("BBformula").FormulaR1C1 = _
    "=IF(R[-2]C=1,OFFSET(StartInputWeeklyAC,-1,VLOOKUP(VLOOKUP(R[-1]C,ListMonths3,2,0),ListWeeks,2,0),1,1),MFC!RC)"

  Sheets("Input").Activate
  Range("BSactual").Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlValues
  Application.CutCopyMode = False

Range("InputWeeksAC").Copy
  Sheets("Weekly Actuals").Select
  Range("StartInputWeeklyAC").Select
  ActiveCell.Offset(0, Range("OffsetActual")).Select
  ActiveSheet.Paste
  Application.CutCopyMode = False

  Range("RedundantLineMFC").ClearContents
  Range("RedundantLineWFC").ClearContents

' Sheets("Weekly Forecast").Activate
' Range("wPotentialLease").Copy
' Selection.PasteSpecial Paste:=xlValues
' Application.CutCopyMode = False
'
' Sheets("Monthly Forecast").Activate
' Range("mPotentialLease").Copy
' Selection.PasteSpecial Paste:=xlValues
' Application.CutCopyMode = False

  Sheets("Input").Activate
  Range("BSActual") = "=IF(Weeknbr=1,'Weekly Actuals'!R4C5,OFFSET('Weekly Actuals'!R47C4,0,Weeknbr))"
  Range("F4") = "=R[43]C[-1]"
  Range("G4") = "=R[43]C[-1]"
  Range("H4") = "=R[43]C[-1]"
  Range("I4") = "=R[43]C[-1]"
  Range("J4") = "=R[43]C[-1]"
  Range("L4") = "=OFFSET(R[43]C[-2],0,-Offset2)"
  Range("M4") = "=R[43]C[-1]"
  Range("N4") = "=R[43]C[-1]"
  Range("O4") = "=R[43]C[-1]"
  Range("P4") = "=R[43]C[-1]"
  Range("Q4") = "=R[43]C[-1]"
  Range("R4") = "=R[43]C[-1]"
  Range("S4") = "=R[43]C[-1]"
  Range("T4") = "=R[43]C[-1]"
  Range("U4") = "=R[43]C[-1]"
  Range("V4") = "=R[43]C[-1]"

  Sheets("Input").Protect

  Sheets("Weekly Forecast").Protect
  Sheets("Monthly Forecast").Protect
  Sheets("Weekly Actuals").Protect

  Range("Input1").ClearContents
  Range("Input2").ClearContents
  Range("Input3").ClearContents
  Range("Input4").ClearContents
  Range("Input5").ClearContents
  Range("Input6").ClearContents
  Range("Input7").ClearContents
  Range("Input8").ClearContents
  Range("Input9").ClearContents
  Range("Input10").ClearContents
  Range("Input11").ClearContents
  Range("Input12").ClearContents
  Range("Input13").ClearContents
  Range("Input14").ClearContents
  Range("Input15").ClearContents
  Range("Input16").ClearContents
  Range("Input17").ClearContents
  Range("Input18").ClearContents

  Sheets("Forecast View").Visible = True

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True

  Sheets("Input").Select
  MsgBox ("De database is bijgewerkt met de input")
End Sub

Module Menu

Met behulp van de module Menu wordt het zelfontworpen menu weergegeven.

Sub CreateMenu()
  Dim newMenu As CommandBar, newControl, newItem, subMenu

  'remove custom menu if it exists
  On Error Resume Next
  CommandBars("CashFlow").Delete
  On Error GoTo 0

  'create new menu and display it
  Set newMenu = CommandBars.Add(Name:="CashFlow", Position:=msoBarTop)
  newMenu.Visible = True
'------------------------------------------------------------------------------------------------------------------
'add control that acts as a button
  Set newItem = newMenu.Controls.Add(Type:=msoControlButton)
  With newItem
    .Caption = " Controlepaneel "
    .Style = msoButtonCaption
    .TooltipText = "Show Cashflow Charts"
    .OnAction = "ControlPanel"
  End With
'-----------------------------------------------------------------------------------------------------------------
'add control that acts as a button
  Set newItem = newMenu.Controls.Add(Type:=msoControlButton)
  With newItem
    .Caption = " Bekijken en invoeren data "
    .Style = msoButtonCaption
    .TooltipText = " Cash flow data raadplegen en invoeren"
    .OnAction = "ViewData"
  End With
'-----------------------------------------------------------------------------------------------------------------
'add control that acts as a button
  Set newItem = newMenu.Controls.Add(Type:=msoControlButton)
  With newItem
    .Caption = " Stoppen "
    .Style = msoButtonCaption
    .TooltipText = "De applicatie stoppen"
    .OnAction = "Quit"
  End With

End Sub

Sub ControlPanel()
  Sheets("Info").Select
End Sub

Sub ViewData()
  Sheets("Forecast View").Select
End Sub

Sub Quit()
    Application.DisplayAlerts = False
    answer = MsgBox("Wilt u echt stoppen met de applicatie?", vbYesNo)    If answer <> vbYes Then Exit Sub
    DeleteMenu
  With ActiveWindow
    .DisplayHeadings = True
    .DisplayWorkbookTabs = True
  End With

  With Application
    .DisplayFullScreen = False
    .DisplayFormulaBar = True
    .DisplayStatusBar = True
    .CommandBars("Formatting").Visible = True
    .CommandBars("Standard").Visible = True
    .CommandBars.LargeButtons = False
  End With
    ActiveWorkbook.Close
End Sub

Sub DeleteMenu()
  Application.CommandBars("CashFlow").Visible = False
End Sub

Module ShowCharts

Deze module zorgt ervoor dat de grafieken op het werkblad Info juist worden weergegeven.

Sub PeriodView()
  Application.ScreenUpdating = False
  ActiveSheet.Unprotect

  If Range("CtrView") = 1 Then
    Rows("10:23").Select
    Selection.EntireRow.Hidden = False
    Rows("10:16").Select
    Selection.EntireRow.Hidden = True
  End If

  If Range("CtrView") = 2 Then
    Rows("10:23").Select
    Selection.EntireRow.Hidden = False
    Rows("16:23").Select
    Selection.EntireRow.Hidden = True
  End If

  Range("E31").Select

  ActiveSheet.Protect
  Application.ScreenUpdating = True
End Sub

Sub ShowWeekView()
  Application.ScreenUpdating = False
  ActiveSheet.Unprotect

  If Range("CtrChartSelection2") = 1 Then
    Rows("26:47").Select
    Selection.EntireRow.Hidden = False
    Rows("48:255").Select
    Selection.EntireRow.Hidden = True
    Range("A1").Activate
  End If

  If Range("CtrChartSelection2") = 2 Then
    Rows("26:255").Select
    Selection.EntireRow.Hidden = True
    Rows("48:71").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Activate
  End If

  If Range("CtrChartSelection2") = 3 Then
    Rows("26:255").Select
    Selection.EntireRow.Hidden = True
    Rows("72:94").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Activate
  End If

  If Range("CtrChartSelection2") = 4 Then
    Rows("26:255").Select
    Selection.EntireRow.Hidden = True
    Rows("95:117").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Activate
  End If

If Range("CtrChartSelection2") = 5 Then
    Rows("26:255").Select
    Selection.EntireRow.Hidden = True
    Rows("118:140").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Activate
  End If

  ActiveSheet.Protect
  Application.ScreenUpdating = True
End Sub

Sub ShowMonthView()
  Application.ScreenUpdating = False
  ActiveSheet.Unprotect

  If Range("CtrChartSelection1") = 1 Then
    Rows("26:255").Select
    Selection.EntireRow.Hidden = True
    Rows("142:163").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Activate
  End If

  If Range("CtrChartSelection1") = 2 Then
    Rows("26:255").Select
     Selection.EntireRow.Hidden = True
    Rows("164:186").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Activate
  End If

  If Range("CtrChartSelection1") = 3 Then
    Rows("26:255").Select
    Selection.EntireRow.Hidden = True
    Rows("187:209").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Activate
  End If

  If Range("CtrChartSelection1") = 4 Then
    Rows("26:255").Select
    Selection.EntireRow.Hidden = True
    Rows("210:232").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Activate
  End If

  If Range("CtrChartSelection1") = 5 Then
    Rows("26:255").Select
    Selection.EntireRow.Hidden = True
    Rows("233:255").Select
    Selection.EntireRow.Hidden = False
    Range("A1").Activate
  End If

  ActiveSheet.Protect
  Application.ScreenUpdating = True
End Sub

Module ThisWorkbook

De module ThisWorkbook roept bij het openen van het werkboek het eigen menu op.

Private Sub Workbook_Open()
  Sheets("Info").Select
  CreateMenu
End Sub

Private Sub Workbook_Activate()
  CreateMenu
End Sub

Private Sub Workbook_Deactivate()
  DeleteMenu
End Sub