eXLBudget_ClickGo

Declaration of the ribbon for the eXLBudget_ClickGo Excel addin which provides feature for working easier with eXL Budget data.

You can see here checkboxes:

eXL_Budget_ClickGo

1. Manifest

<customUI onLoad="Toolbar.Ribbon_onLoad" xmlns="http://schemas.microsoft.com/office/2009/07/customui">
   <ribbon startFromScratch="false">
      <tabs>
         <tab id="eXLHelper" label="Click&amp;&amp;Go" insertBeforeMso="TabHome" keytip="eXL" getVisible="getVisibleClickGo_Ribbon">
            <group id="grpParams" label="Parameters">
               <dropDown id="cbxEnvironment" label="Environment" screentip="Select the environment" supertip="SuperTip" onAction="Toolbar.onChangecbxEnvironment" getSelectedItemID="Toolbar.GetEnvSelectedItemID">
                  <item id="env_Prod" label="Production"/>
                  <item id="env_Training" label="Training"/>
               </dropDown>               
               <dropDown id="cbxBudgetYear" label="BudgetYear" screentip="Select a BudgetYear" supertip="SuperTip" onAction="Toolbar.onChangecbxBudgetYear" getSelectedItemID="Toolbar.GetBudgetYearSelectedItemID">
                  <item id="year_2020" label="2020"/>
                  <item id="year_2019" label="2019"/> 
                  <item id="year_2018" label="2018"/> 
                  <item id="year_2017" label="2017"/> 
                  <item id="year_2016" label="2016"/> 
                  <item id="year_2015" label="2015"/> 
                  <item id="year_2014" label="2014"/>
                  <item id="year_2013" label="2013"/>
               </dropDown>
               <dropDown id="cbxBudgetType" label="BudgetType" screentip="Select a BudgetType" supertip="0 for Expenses (BGD/AUB) and 1 for Incomes (BVM/MB)" onAction="Toolbar.onChangecbxBudgetType" getSelectedItemID="Toolbar.GetBudgetTypeSelectedItemID">
                  <item id="type_0" label="0 | D?penses | Uitgaven"/>
                  <item id="type_1" label="1 | Recettes | Inkomsten"/>
               </dropDown>
               <dropDown id="cbxBudgetCycle" label="BudgetCycle" screentip="Select a BudgetCycle" supertip="0 for initial (INI) and 1 for budgetary control (CB/BC)" onAction="Toolbar.onChangecbxBudgetCycle" getSelectedItemID="Toolbar.GetBudgetCycleSelectedItemID">
                  <item id="cycle_0" label="0 | Initial"/>
                  <item id="cycle_1" label="1 | Cycle 1 (probably Budgetary control)"/>
                  <item id="cycle_2" label="2 | Cycle 2 (probably First adjustment)"/>
                  <item id="cycle_3" label="3 | Cycle 3"/>
                  <item id="cycle_4" label="4 | Cycle 4"/>
                  <item id="cycle_5" label="5 | Cycle 5"/>
               </dropDown>
               <dropDown id="cbxPhaseNumber" label="PhaseNumber" screentip="Select a PhaseNumber" supertip="Obtain the most recent figures by selecting the most recent phase" onAction="Toolbar.onChangecbxPhaseNumber" getSelectedItemID="Toolbar.GetPhaseNumberSelectedItemID">
                  <item id="phase_00" label="00 | Encodage | Codering"/>
                  <item id="phase_01" label="01 | Analyse"/>
                  <item id="phase_02" label="02 | Pr?-bila | Pre-bila"/>
                  <item id="phase_03" label="03 | Bila"/>
                  <item id="phase_04" label="04 | Post-bila"/>
                  <item id="phase_05" label="05 | Premier conclave | Eerste conclaaf"/>
                  <item id="phase_06" label="06 | Second conclave | Tweede conclaaf"/>
                  <item id="phase_07" label="07 | Premier post-conclave | Eerste post-conclaaf"/>
                  <item id="phase_08" label="08 | Second post-conclave | Tweede post-conclaaf"/>
                  <item id="phase_09" label="09 | Amendement"/>
                  <item id="phase_10" label="10 | Errata"/>
                  <item id="phase_99" label="99 | Current calendar phase"/>
               </dropDown>
               <dropDown id="cbxSPF" label="SPF/FOD" screentip="Select a SPF" supertip="SuperTip" onAction="Toolbar.onChangecbxSPF" getSelectedItemID="Toolbar.GetSPFSelectedItemID">
                  <item id="spf_all" label="ALL" />
                  <item id="spf_01" label="01 | DOTATIONS | DOTATIES"/>
                  <item id="spf_02" label="02 | CHANCELLERIE | KANSELARIJ"/>
                  <item id="spf_03" label="03 | BUDGET/CONTROLE DE LA GESTION | BUDGET &amp; BEHEERSCONTROLE"/>
                  <item id="spf_04" label="04 | PERSONNEL ET ORGANISATION | PERSONEEL EN ORGANISATIE"/>
                  <item id="spf_05" label="05 | FEDICT | FEDICT"/>
                  <item id="spf_06" label="06 | BOSA | BOSA"/>
                  <item id="spf_07" label="07 | ORGANES INDEPENDANTS | ONAFHANKELIJKE ORGANEN" />
                  <item id="spf_12" label="12 | JUSTICE | JUSTITIE"/>
                  <item id="spf_13" label="13 | INTERIEUR | BINNENLANDSE ZAKEN"/>
                  <item id="spf_14" label="14 | AFFAIRES ETRANGERES &amp; COOPER. | BUIT. ZAKEN &amp; ONTW.-SAMENWERK."/>
                  <item id="spf_16" label="16 | DEFENSE NATIONALE | LANDSVERDEDIGING"/>
                  <item id="spf_17" label="17 | POLICE FED. &amp; FONCT. INTEGRE | FED. POLITIE &amp; GEINT. WERKING"/>
                  <item id="spf_18" label="18 | FINANCES | FINANCIEN"/>
                  <item id="spf_19" label="19 | REGIE DES BATIMENTS | REGIE DER GEBOUWEN + OP. AMBT"/>
                  <item id="spf_21" label="21 | PENSIONS | PENSIOENEN"/>
                  <item id="spf_23" label="23 | EMPLOI, TRAVAIL &amp; CONC. SOC. | WERKGELEGENHEID, ARBEID &amp; S.O."/>
                  <item id="spf_24" label="24 | SPF SECURITE SOCIALE | FOD SOCIALE ZEKERHEID"/>
                  <item id="spf_25" label="25 | SANTE PUBLIQUE | VOLKSGEZONDHEID"/>
                  <item id="spf_32" label="32 | ECONOMIE | ECONOMIE"/>
                  <item id="spf_33" label="33 | SPF MOBILITE ET TRANSPORTS | FOD MOBILITEIT EN VERVOER"/>
                  <item id="spf_44" label="44 | INTEGRATION SOCIALE | MAATSCHAPPELIJKE INTEGRATIE"/>
                  <item id="spf_46" label="46 | POLITIQUE SCIENTIFIQUE | WETENSCHAPSBELEID"/>
                  <item id="spf_51" label="51 | DETTE PUBLIQUE | RIJKSSCHULD"/>
                  <item id="spf_52" label="52 | UNION EUROPEENNE | EUROPESE UNIE"/>
                  <item id="spf_67" label="67 | PROVISION FEDERALE POLICE | PROVISIE FEDERALE POLITIE"/>
               </dropDown>
            </group>
            <group id="eXLHelpersAdvanced" label="Advanced" >
               <checkBox id="chkOverwrite" label="Overwrite content" getPressed="GetPressedchkOverwrite" onAction="ClickchkOverwrite" supertip="The 'Fill in' functionnalitywill retrieve fields value from the database but won't replace the current value if there is already one.  Activate this option if you wish to reset the current value (if any) by the value from the database."/>
               <checkBox id="chkHighlight" label="Highlight cell" getPressed="GetPressedchkHighlight" onAction="ClickchkHighlight" supertip="Activate this option if you wish to see which cells have been updated by the 'Fill in' functionnality."/>
               <checkBox id="chkNotFound" label="Display #NotFound" getPressed="GetPressedchkNotFound" onAction="ClickchkNotFound" supertip="If enabled, when the AB/article doesn't exists, a #NotFound error will be displayed in the searched cell.   Disable this option to keep the searched cell empty."/>
               <checkBox id="chkNotAutofit" label="Autofit" getPressed="GetPressedchkAutofit" onAction="ClickchkAutofit" supertip="Once 'Fill In' is finished, do you wish that Click&amp;Go make an Column's autofit ?"/>
            </group>
            <group id="eXLHelpersGlobal" label="Click&amp;&amp;Go" >
               <button id="eXLGetDataSheet" label="Get" size="large" onAction="clickGetDataSheet" imageMso="CreateTable" supertip="Extract the last figures from eXL-Budget" />
               <button id="eXLFillIn" label="Fill in" size="large" onAction="clickFillIn" imageMso="FilePrepareMenu" supertip="Fill in columns in the active sheet by retrieving these informations from the eXL database; AB by AB&#xD;&#xD;PRO TIP: If you wish to update only one or more columns, select them before clicking on this button" />
               <button id="eXLExpandRange" label="Expand range" size="large" onAction="clickExpandRange" image="expand_range" supertip="When the 'Fill in' functionnality isn't able to retrieve the exact definition of your data range, select the range i.e. the first row with field's name and all your data rows then click on this button.   This will define the range to use.   'Fill in' will then be able to retrieve all your datas."/>
               <button id="eXLFieldList" label="Get list of fields" size="large" onAction="clickFieldList" imageMso="FunctionsDateTimeInsertGallery" />
               <button id="eXLTutorial" label="Tutorial" size="large" onAction="clickTutorial" imageMso="TentativeAcceptInvitation" />
            </group>

         </tab>
      </tabs>
   </ribbon>
</customUI>

2. VBA

Associated VBA code (in a module called Toolbar, thats why callbacks starts with Toolbar.)

Attribute VB_Name = "Toolbar"
' -----------------------------------------------------------------------------------------------------------------------------------------------------------
'
' Author       : AVONTURE Christophe
'
' Aim          : eXLBudget_Click&amp;Go.xlam - Module Toolbar
'
' Written date : January 2015
'
' Last modification
'
' December 2016 - Everyone can see the ribbon (sub getVisibleClickGo_Ribbon() updated)
' June 2018 - Don't update value when the cell is locked (Sub clickFillIn)
'
' -----------------------------------------------------------------------------------------------------------------------------------------------------------

Option Explicit
Option Base 0
Option Compare Text

Private p_Ribbon As Office.IRibbonUI

Public Sub Ribbon_onLoad(ribbon As IRibbonUI)

   Set p_Ribbon = ribbon

   bchkOverwrite = False
   bchkHighlight = True
   bchkNotFound = True
   bchkAutoFit = True

   On Error Resume Next
   Call CAVO_AddIn.cWorkbook.AddCustomProperty("ApplicationTitle", "eXL-Budget - Click &amp; Go")
   On Error GoTo 0

End Sub

Sub getVisibleClickGo_Ribbon(control As IRibbonControl, ByRef returnedVal)

Dim bCanSee As Boolean
Dim sUserName As String

   On Error Resume Next
   bCanSee = False
   ' Get the connected username
   sUserName = CAVO_AddIn.cUser.Name

   ' December 2016 - Everyone can see the ribbon
   'If (sUserName = "YOURICT\avonture_christophe") Or (sUserName = "YOURICT\bauwens_anne") Or (sUserName = "YOURICT\laurent_sebastien") Then
   '   bCanSee = True
   'End If
   bCanSee = True
   On Error GoTo 0

   returnedVal = bCanSee

End Sub

' Define the default environment

Public Sub GetEnvSelectedItemID(control As IRibbonControl, ByRef itemID As Variant)
   If IsEmpty(wEnvironment) Then wEnvironment = 0
   itemID = IIf(wEnvironment = 0, "env_Prod", "env_Training")
End Sub

' Define the default BudgetYear

Public Sub GetBudgetYearSelectedItemID(control As IRibbonControl, ByRef itemID As Variant)
   If IsEmpty(wBudgetYear) Or (wBudgetYear = 0) Then wBudgetYear = Year(Now()) + 1
   cAB.BudgetYear = wBudgetYear
   itemID = "year_" &amp; wBudgetYear
End Sub

' Define the default BudgetType

Public Sub GetBudgetTypeSelectedItemID(control As IRibbonControl, ByRef itemID As Variant)
   If IsEmpty(wBudgetType) Then wBudgetType = 0
   cAB.BudgetType = wBudgetType
   itemID = "type_" &amp; wBudgetType
End Sub

' Define the default BudgetCycle

Public Sub GetBudgetCycleSelectedItemID(control As IRibbonControl, ByRef itemID As Variant)
   If IsEmpty(wBudgetCycle) Then wBudgetCycle = 0
   cAB.BudgetCycle = wBudgetCycle
   itemID = "cycle_" &amp; wBudgetCycle
End Sub

' Define the default SPF

Public Sub GetSPFSelectedItemID(control As IRibbonControl, ByRef itemID As Variant)
   If IsEmpty(sSPF) Or (sSPF = "") Then sSPF = "all"
   itemID = "spf_" &amp; sSPF
End Sub

' Define the default PhaseNumber

Public Sub GetPhaseNumberSelectedItemID(control As IRibbonControl, ByRef itemID As Variant)
   cAB.PhaseNumber = wPhaseNumber
   itemID = "phase_" &amp; Right("00" &amp; wPhaseNumber, 2)
End Sub

Sub onChangecbxEnvironment(control As IRibbonControl, selectedId As String, selectedIndex As Integer)
   If (selectedId = "env_Prod") Then wEnvironment = 0 Else wEnvironment = 1
   Call Helper.ShowCurrentParameters
End Sub

Public Sub onChangecbxSPF(control As IRibbonControl, selectedId As String, selectedIndex As Integer)

   If (selectedId = "spf_all") Then sSPF = "%" Else sSPF = Right(selectedId, 2)
   Call Helper.ShowCurrentParameters
   Call CAVO_AddIn.cData.AddVariable("SPF", sSPF)

End Sub

Public Sub onChangecbxBudgetYear(control As IRibbonControl, selectedId As String, selectedIndex As Integer)

   wBudgetYear = Int(Right(selectedId, 4))
   Call Helper.ShowCurrentParameters
   cAB.BudgetYear = wBudgetYear
   Call CAVO_AddIn.cData.AddVariable("BudgetYear", wBudgetYear)

End Sub

Public Sub onChangecbxBudgetType(control As IRibbonControl, selectedId As String, selectedIndex As Integer)

   wBudgetType = Int(Right(selectedId, 1))
   Call Helper.ShowCurrentParameters
   cAB.BudgetType = wBudgetType
   Call CAVO_AddIn.cData.AddVariable("BudgetType", wBudgetType)

End Sub

Public Sub onChangecbxBudgetCycle(control As IRibbonControl, selectedId As String, selectedIndex As Integer)

   wBudgetCycle = Int(Right(selectedId, 1))
   Call Helper.ShowCurrentParameters
   cAB.BudgetCycle = wBudgetCycle
   Call CAVO_AddIn.cData.AddVariable("BudgetCycle", wBudgetCycle)

End Sub

Public Sub onChangecbxPhaseNumber(control As IRibbonControl, selectedId As String, selectedIndex As Integer)

   wPhaseNumber = Int(Right(selectedId, 2))
   Call Helper.ShowCurrentParameters
   cAB.PhaseNumber = wPhaseNumber
   Call CAVO_AddIn.cData.AddVariable("PhaseNumber", wPhaseNumber)

End Sub

Public Sub GetPressedchkAutofit(control As IRibbonControl, ByRef returnedVal)
   returnedVal = bchkAutoFit
End Sub
Public Sub GetPressedchkOverwrite(control As IRibbonControl, ByRef returnedVal)
   returnedVal = bchkOverwrite
End Sub
Public Sub GetPressedchkNotFound(control As IRibbonControl, ByRef returnedVal)
   returnedVal = bchkNotFound
End Sub
Public Sub clickchkAutofit(control As IRibbonControl, pressed As Boolean)
   bchkAutoFit = pressed
End Sub
Public Sub clickchkOverwrite(control As IRibbonControl, pressed As Boolean)
   bchkOverwrite = pressed
End Sub
Public Sub clickchkNotFound(control As IRibbonControl, pressed As Boolean)
   bchkNotFound = pressed
End Sub
Public Sub GetPressedchkHighlight(control As IRibbonControl, ByRef returnedVal)
   returnedVal = bchkHighlight
End Sub
Public Sub clickchkHighlight(control As IRibbonControl, pressed As Boolean)
   bchkHighlight = pressed
End Sub

Public Sub clickTutorial(control As IRibbonControl)

Dim sPassword As String, sFile As String
Dim wb As Workbook
Dim sh As Worksheet
Dim bScreenUpdating As Boolean

   sFile = CAVO_AddIn.cFolder.GetParentFolderName(ThisWorkbook.FullName)
   sFile = sFile &amp; "\Click&amp;Go_Samples\demo.xlsx"

   If (CAVO_AddIn.cFile.Exists(sFile)) Then

      Set wb = Application.Workbooks.Open(Filename:=sFile, ReadOnly:=True, Notify:=False, AddToMRU:=False)

      If Not wb.ProtectStructure Then

         sPassword = CAVO_AddIn.cPassword.Password
         CAVO_AddIn.cPassword.Password = "Click&amp;Go"
         CAVO_AddIn.cPassword.isObfuscated = False

         bScreenUpdating = Application.ScreenUpdating
         Application.ScreenUpdating = False

         Call CAVO_AddIn.cWorkbook.Protect(CAVO_AddIn.cPassword.Password, wb)

         For Each sh In wb.Worksheets
            sh.Select
            Call CAVO_AddIn.cRange.SelectTopLeft(sh)
            Call CAVO_AddIn.cSheet.Protect(sh, CAVO_AddIn.cPassword.Password, , , xlNoRestrictions)
         Next

         wb.Worksheets("Quick infos").Select

         ' Fake, prevent Excel to display the "File has been changed... Do you want to save it" dialog
         wb.Saved = True
         Set sh = Nothing
         Set wb = Nothing

         ' Restore the default password
         'CAVO_AddIN.cPassword.Password = sPassword

         Application.ScreenUpdating = bScreenUpdating

      End If
   Else

      Call CAVO_AddIn.cMessage.Show("eXLBudget_Click&amp;Go - Toolbar::clickTutorial", "Sorry, the tutorial was not found", Error)
   End If

End Sub

' --------------------------------------------------------------------------------------------------------------------------------------
'
' Append a new worksheet in the current workbook and run a query agains the database.  Retrieve all records for a specific
'
' * BudgetYear
' * BudgetType
' * BudgetCycle
' * PhaseNumber
'
' For one or all SPFs.
'
' --------------------------------------------------------------------------------------------------------------------------------------

Public Sub clickGetDataSheet(control As IRibbonControl)

Dim sColumn As String, sFieldName As String, sFormula As String, sName As String, sFileName As String, sTitle As String
Dim bEvents As Boolean, bScreenUpdating As Boolean, bAlerts As Boolean, bWorkbookCreated As Boolean
Dim sh As Worksheet
Dim wb As Workbook
Dim I As Integer, J As Integer
Dim wFirstDataColumn As Byte, wFirstDataRow As Byte, wLastDataRow As Long, wLastDataColumn As Long
Dim wRow As Byte
Dim rng As Range, rngData As Range
Dim cols As ABKey_Columns

Static wRandom As Byte

   bEvents = Application.EnableEvents
   bScreenUpdating = Application.ScreenUpdating

   Application.EnableEvents = False
   Application.ScreenUpdating = False

   bWorkbookCreated = False

   Call eXLBudget_ClickGo.clsData.Conn_Open
   Set rs = eXLBudget_ClickGo.clsData.GetRecordSet(cGetFigures)

   Set wb = Nothing

   If Not (ActiveWorkbook Is Nothing) Then
      If Not ActiveWorkbook.ProtectStructure Then
         Set wb = ActiveWorkbook
      End If
   End If

   If (wb Is Nothing) Then

      Set wb = Application.Workbooks.Add
      Set sh = ActiveWorkbook.Worksheets(1)

      bWorkbookCreated = True

      bAlerts = Application.DisplayAlerts
      Application.DisplayAlerts = False
      If (CAVO_AddIn.cSheet.Exists("Sheet2", wb)) Then Call CAVO_AddIn.cSheet.Delete("Sheet2", wb)
      If (CAVO_AddIn.cSheet.Exists("Sheet3", wb)) Then Call CAVO_AddIn.cSheet.Delete("Sheet3", wb)
      Application.DisplayAlerts = bAlerts

   Else
      Set sh = wb.Worksheets.Add
   End If

   ' Try to give a name to the sheet
   On Error Resume Next
   sName = "Y" &amp; wBudgetYear &amp; "_C" &amp; wBudgetCycle &amp; "_P" &amp; wPhaseNumber &amp; "_S" &amp; IIf(sSPF = "%", "All", sSPF)
   sh.Name = sName
   If (Err.Number <> 0) Then
      wRandom = wRandom + 1
      sh.Name = sName &amp; "_" &amp; wRandom
   End If
   On Error GoTo 0

   ' Training ?
   If (Variables.wEnvironment = 1) Then

      With sh.Cells(1, 1)
         .Value = "TRAINING"
         .Font.Bold = True
         .Font.Color = vbRed
         .Font.Size = 14
         .Interior.Color = vbYellow
      End With

   End If

   ' Title of the sheet and will be used as title for the workbook too
   sTitle = "Click&amp;Go - Data extraction"

   sh.Range(sh.Cells(2, 1), sh.Cells(2, 10)).Merge
   With sh.Cells(2, 1)
      .Value = sTitle
      .Font.Bold = True
      .Font.Size = 14
   End With

   sh.Range(sh.Cells(3, 1), sh.Cells(3, 10)).Merge
   With sh.Cells(3, 1)
      .Value = "[BudgetYear]=" &amp; wBudgetYear &amp; ", [BudgetType]=" &amp; IIf(wBudgetType = 0, "Expenses", "Incomes") &amp; ", " &amp; _
         "[BudgetCycle]=" &amp; wBudgetCycle &amp; ", [PhaseNumber]=" &amp; Helper.GetPhaseTitle(wPhaseNumber) &amp; ", [SPF]=" &amp; IIf(sSPF = "%", "All", sSPF)
      sTitle = sTitle &amp; " - " &amp; .Value
      .Font.Bold = True
      .Font.Size = 10
   End With

   wFirstDataColumn = 1
   wFirstDataRow = 5

   ' Output fieldsname

   J = rs.Fields.Count - 1

   For I = 0 To J
       sh.Cells(wFirstDataRow, I + wFirstDataColumn + 1).Value = rs.Fields(I).Name
   Next

   ' Output data

   sh.Cells(wFirstDataRow + 1, wFirstDataColumn + 1).CopyFromRecordset rs

   ' Give a name to the recordset.  _dsData can then be used by the "Fill in" option
   Call CAVO_AddIn.cName.Add(sName:="_dsData", sValue:="=" &amp; sh.Name &amp; "!" &amp; sh.Cells(wFirstDataRow + 1, wFirstDataColumn).CurrentRegion.Address, Visible:=False, sh:=sh)

   wLastDataRow = sh.UsedRange.Rows.Count + wFirstDataRow - 1
   wLastDataColumn = sh.UsedRange.Columns.Count

   ' Add the AB key
   sh.Cells(wFirstDataRow, wFirstDataColumn).Value = "ABKey"

   sColumn = CAVO_AddIn.cRange.GetColumnLetter(wFirstDataColumn, sh.Name)
   Call CAVO_AddIn.cName.Add(sName:="_rngABKey", sValue:="=" &amp; sh.Name &amp; "!$" &amp; sColumn &amp; "$" &amp; wFirstDataRow &amp; ":$" &amp; sColumn &amp; "$" &amp; wLastDataRow, Visible:=True, sh:=sh, wb:=wb)

   ' Give a name to each columns

   J = rs.Fields.Count - 1

   For I = 0 To J

       sColumn = CAVO_AddIn.cRange.GetColumnLetter(I + wFirstDataColumn + 1, sh.Name)

       sFieldName = rs.Fields(I).Name

       ' Give a name to the range
       Call CAVO_AddIn.cName.Add(sName:="_rng" &amp; sFieldName, sValue:="=" &amp; sh.Name &amp; "!$" &amp; sColumn &amp; "$" &amp; wFirstDataRow &amp; ":$" &amp; sColumn &amp; "$" &amp; wLastDataRow, Visible:=True, sh:=sh, wb:=wb)

       If (CAVO_AddIn.cFunctions.in_array(sFieldName, Array("SPF", "OrganicDivision", "Program", "Activity", "EconomicCode", "CodeSEC", "OrderNumber", "Littera")) > -1) Then
          Select Case sFieldName
             Case "SPF": cols.SPF = sColumn
             Case "OrganicDivision": cols.OrganicDivision = sColumn
             Case "Program": cols.Program = sColumn
             Case "Activity": cols.Activity = sColumn
             Case "EconomicCode": cols.EconomicCode = sColumn
             Case "CodeSEC": cols.CodeSEC = sColumn
             Case "OrderNumber": cols.OrderNumber = sColumn
             Case "Littera": cols.Littera = sColumn
          End Select
       End If

   Next

   ' -------------------------------------------------------------------------------------------------------
   '
   ' Make the formula to derive the AB key
   wRow = wFirstDataRow + 1
   sFormula = "=" &amp; cols.SPF &amp; wRow &amp; "&amp;" &amp; cols.OrganicDivision &amp; wRow &amp; "&amp;" &amp; cols.Program &amp; wRow &amp; _
       "&amp;" &amp; cols.Activity &amp; wRow &amp; "&amp;" &amp; cols.EconomicCode &amp; wRow &amp; "&amp;" &amp; cols.CodeSEC &amp; wRow &amp; _
       "&amp;" &amp; cols.OrderNumber &amp; wRow &amp; "&amp;" &amp; cols.Littera &amp; wRow

   sh.Range(sh.Cells(wFirstDataRow + 1, wFirstDataColumn), sh.Cells(wFirstDataRow + wLastDataRow - 2, wFirstDataColumn)).Formula = sFormula
   ' Remove the formula; keep only the value and be sure to keep the zero preceding
   sh.Range("_rngABKey").NumberFormat = "@"
   sh.Range("_rngABKey").Value = sh.Range("_rngABKey").Value
   ' -------------------------------------------------------------------------------------------------------

  ' Set rng = sh.UsedRange ' sh.Range(sh.Cells(wFirstDataRow, wFirstDataColumn), sh.Cells(wLastDataRow + 1, wLastDataColumn + wFirstDataColumn - 1))
  ' Set rngData = CAVO_AddIn.crange.Resize(rng)
  ' Call CAVO_AddIn.cName.Add("_dsData", "=" &amp; sh.Name &amp; "!" &amp; rng.Address, True, sh, wb)

   ' Display
   ' Set the RefDate column (as from row 2) as DD/MM/YYYY
   CAVO_AddIn.cRange.Resize(sh.Range("_rngRefDate"), 2).NumberFormat = "dd/mm/yyyy"
   CAVO_AddIn.cRange.Resize(sh.Range("_rngSPF"), 2).NumberFormat = "@"
   CAVO_AddIn.cRange.Resize(sh.Range("_rngOrganicDivision"), 2).NumberFormat = "@"
   CAVO_AddIn.cRange.Resize(sh.Range("_rngEconomicCode"), 2).NumberFormat = "@"
   CAVO_AddIn.cRange.Resize(sh.Range("_rngCodeSEC"), 2).NumberFormat = "@"
   CAVO_AddIn.cRange.Resize(sh.Range("_rngOrderNumber"), 2).NumberFormat = "@"

   sh.Cells(wFirstDataRow, wFirstDataColumn).AutoFilter

   Call CAVO_AddIn.cWindow.NiceDisplay

   sh.Cells(wFirstDataRow + 1, wFirstDataColumn).Select
   ActiveWindow.FreezePanes = True

   Call CAVO_AddIn.cRange.AutoFit(sh:=sh, autofitcolumns:=True)

   Call eXLBudget_ClickGo.clsData.Conn_Close

   Application.EnableEvents = bEvents
   Application.ScreenUpdating = bScreenUpdating

   If bWorkbookCreated Then
      wb.BuiltinDocumentProperties("Title") = sTitle
      sFileName = cFile.RemoveExtension(cFile.GetTempFileName)
      wb.SaveAs sFileName
   End If

   Set sh = Nothing
   Set wb = Nothing

   On Error Resume Next
   If Not (CAVO_AddIn.ribbon Is Nothing) Then CAVO_AddIn.ribbon.Invalidate
   On Error GoTo 0

End Sub

Private Function SetCellValue(ByRef cell As Range, ByVal sValue As String) As Boolean
   SetCellValue = (bchkOverwrite Or (cell.Value <> sValue))
End Function

' -----------------------------------------------------------------------------------------------------------------------------
'
' Search a value from the rs object that contains the list of fields.
'
' The rs object has been initialized like that :
'
'     Set rsFieldList = eXLBudget_ClickGo.clsData.GetRecordSet(cGetFieldsList)
'  And thus contains a recordset with these columns (example) :
'
'  Position    FieldName   Type    MaxLength   Description
'  10          CodeSEC     char    2           BGD/BVM : CodeSEC; the third and  (...)
'
' The GetFieldInfo function will loop in this recordset and will find a given FieldName (f.i. CodeSEC).
' If found, the function will return the sDesiredValue field (f.i. "Description")
'
' -----------------------------------------------------------------------------------------------------------------------------

Private Function GetFieldInfo(ByRef rs As ADODB.Recordset, ByVal sSearchedField As String, ByVal sDesiredValue As String, _
   Optional ByVal sDefault As String = "Text") As String

Dim sResult As String

   sResult = sDefault

   If Not (rs Is Nothing) Then
      rs.MoveFirst
      Do While Not rs.EOF
         If (rs.Fields("FieldName").Value = sSearchedField) Then
            sResult = rs.Fields(sDesiredValue).Value
            Exit Do
         End If
         rs.MoveNext
      Loop
   End If

   GetFieldInfo = sResult

End Function

Public Sub clickFillIn(control As IRibbonControl)

Dim rng As Range, rngData As Range, rngRow As Range, rngSelected As Range, rngProcessedColumn As Range
Dim wCol As Long, J As Long, K As Byte, wFieldsProcessed As Byte, wFieldsNotFound As Byte, wRow As Long, wFirstDataRow As Long, wLastDataRow As Long
Dim sFieldName As String, sABKey As String, sOldABKey As String, sComment As String, sType As String, sFormat As String
Dim sh As Worksheet
Dim rs As ADODB.Recordset, rsBistel As ADODB.Recordset, rsFieldList As ADODB.Recordset
Dim bContinue As Boolean, bGetBistel As Boolean, bFirst As Boolean
Dim bEnableEvents As Boolean, bScreenUpdating As Boolean, bOpenedConnection As Boolean, bAllowScreenUpdating As Boolean
Dim sTemp As String, sValue As String, sOldValue As String, sKey As String
Dim arrFieldsProcessed() As Variant, arrFieldsNotFound() As Variant
Dim xlSelect As XlEnableSelection

   Application.EnableCancelKey = xlErrorHandler

   If (wBudgetYear = 0) Then
      Call Helper.ShowError("Sorry, a problem has occured with the ribbon.  Please select again the BudgetYear from the ribon.")
      Exit Sub
   End If

   ' No workbook opened (ActiveSheet is nothing) or an empty sheet (UsedRange only count 1 cell)

   bContinue = Not (ActiveSheet Is Nothing)
   If bContinue Then bContinue = ActiveSheet.UsedRange.Cells.Count > 1

   If Not bContinue Then

      ' Ask if the user wish to split an AB key into fields (SPF, OrganicDivision, ...)

      sKey = InputBox("If you want to split a key into the different fields (SPF, OrganicDivision, ...), please mention here the key of the AB", _
        "", "030101122148#")

      If (sKey <> "") Then

         sKey = Trim(sKey)
         sKey = Replace(sKey, " ", "")
         sKey = Replace(sKey, ".", "")
         sKey = Replace(sKey, "-", "")

         If (ActiveSheet Is Nothing) Then Application.Workbooks.Add
         Set sh = ActiveSheet

         With sh
            .Cells(1, 1).Value = "ABKey"
            If Not .Cells(2, 1).Locked Then .Cells(2, 1).Cells.NumberFormat = "@"
            .Cells(2, 1).Value = sKey
            .Cells(1, 2).Value = "SPF"
            .Cells(1, 3).Value = "OrganicDivision"
            .Cells(1, 4).Value = "Program"
            .Cells(1, 5).Value = "Activity"
            .Cells(1, 6).Value = "EconomicCode"
            .Cells(1, 7).Value = "CodeSEC"
            .Cells(1, 8).Value = "OrderNumber"
            .Cells(1, 9).Value = "Littera"
         End With

         On Error Resume Next
         sh.Columns.AutoFit
         Err.Clear
         On Error GoTo 0

      Else

         Call Helper.ShowError("Please first open a workbook")
         Exit Sub

      End If

   End If

   Set sh = ActiveSheet

   xlSelect = sh.EnableSelection
   sh.EnableSelection = xlNoSelection

   ' Full range; including the field's name
   Set rng = sh.UsedRange
   If (CAVO_AddIn.cName.Exists("_dsData", sh)) Then Set rng = sh.Range("_dsData")

   If rng Is Nothing Then
      Call Helper.ShowError("The sheet is empty")
      Exit Sub
   End If

   bOpenedConnection = False
   bEnableEvents = Application.EnableEvents
   Application.EnableEvents = False
   bScreenUpdating = Application.ScreenUpdating

   If Selection.Cells.Count > 1 Then Set rngSelected = Selection

   ' Data range; excluding the field's name; resize as from row 2 of the range
   Set rngData = CAVO_AddIn.cRange.Resize(rng, 2)
   'rngData.Select

   ' Remember the first and the last row of the range
   wFirstDataRow = rngData.Row
   wLastDataRow = rngData.Rows.Count + wFirstDataRow - 1

   ' Initialization
   bFirst = True

   ' Till now, no fields have been processed
   wFieldsProcessed = 0
   wFieldsNotFound = 0

   Call cAB.SetDataRange(rng)
   Call cAB.GetABCols

   If (cAB.ABKeyFieldsPresent) Then

      wRow = 0

      ' Verify that part of the keys (fields SPF, OrganicDivision, ...) are well mentionned in the Excel table
      J = rngData.Columns.Count

      ' Check if one of the field that is present in the Excel data range is a field that should comes from Bistel

      bGetBistel = False

      For wCol = 1 To J

         sFieldName = Trim(rng.Cells(1, wCol).Value)

         If (CAVO_AddIn.cFunctions.in_array(sFieldName, Array("DescriptionFrench", "FR1", "FR2", "FR3", "FR4", "FR5", "FR6", "FR7", "FR8", "FR9", _
            "DescriptionDutch", "NL1", "NL2", "NL3", "NL4", "NL5", "NL6", "NL7", "NL8", "NL9")) > -1) Then
            bGetBistel = True
            Exit For
         End If

      Next wCol

      For Each rngRow In rngData.Rows

         bAllowScreenUpdating = True

         wRow = wRow + 1

         bContinue = True

         ' The selected area can be columns (like columns I,J,K and Y) but also rows
         ' (like $I$5 till $K$15).  Only selected rows and columns should be processed

         If Not (rngSelected Is Nothing) Then
            If (Intersect(rngSelected.EntireRow, rngRow) Is Nothing) Then bContinue = False
         End If

         If bContinue Then ' Process the row

            ' Get the row to process : ony by one
            cAB.Row = wRow

            If cAB.SPF = "" Then bContinue = False: J = 0

            For wCol = 1 To J

               sFieldName = Trim(rng.Cells(1, wCol).Value)
               bContinue = (sFieldName <> "")

               If bContinue Then

                  ' Perhaps the user has requested to search for an inexisting field (like "vkconc1" (the correct name is vkconc)).
                  ' So, the first time, the request will be in order to retrieve that field.   The second time, no more searched will be done
                  ' since the arrFieldsNotFound had been populated with this name

                  If wFieldsNotFound > 0 Then bContinue = (CAVO_AddIn.cFunctions.in_array(sFieldName, arrFieldsNotFound) = -1)

               End If

               ' If the user has selected one or more columns, only process these columns
               If bContinue And Not (rngSelected Is Nothing) Then
                  If (Intersect(rngSelected.EntireColumn, rng.Cells(1, wCol)) Is Nothing) Then
                     bContinue = False
                  Else
                     ' The field match one column that was selected before calling FillIn รข&#135;&#146; process that column
                  End If
               End If

               If bContinue Then

                  rngRow.Cells(1, wCol).Select

                  ' 20180611 - Don't modify the cell when it's locked
                  If Not (ActiveCell.Locked) And (IsEmpty(ActiveCell) Or (ActiveCell.Value = cNotFound) Or bchkOverwrite) Then

                     If Not (ActiveSheet.ProtectContents) And Not (ActiveSheet.ProtectContents) Then

                         If cAB.SPF <> "" Then

                            ' Optimization : remember the value of the ABKey
                            sABKey = cAB.ABKey

                            sValue = ActiveCell.Value
                            sOldValue = ActiveCell.Value

                            Call CAVO_AddIn.cApp.Status("Process " &amp; cAB.ABKey &amp; "  (" &amp; wRow &amp; "/" &amp; rngData.Rows.Count &amp; ")")

                            Select Case sFieldName

                               Case "ABKey": If bchkOverwrite Or ActiveCell.Value = "" Then sValue = sABKey

                               Case "SPF", "BUD", "FOD", "Chap", "Chapter", "Chapitre", "Hoofdstuk":
                                  sTemp = cAB.SPF
                                  If SetCellValue(ActiveCell, sTemp) Then sValue = sTemp
                                  On Error Resume Next: ActiveCell.NumberFormat = "00": Err.Clear: On Error GoTo 0

                               Case "OrganicDivision", "DO", "Division", "Titre", "Titel":
                                  sTemp = cAB.OrganicDivision
                                  If SetCellValue(ActiveCell, sTemp) Then sValue = sTemp
                                  On Error Resume Next: ActiveCell.NumberFormat = "00": Err.Clear: On Error GoTo 0

                               Case "Program", "Programme", "PRO", "PROG", "Section", "Sectie":
                                  sTemp = cAB.Program
                                  If SetCellValue(ActiveCell, sTemp) Then sValue = sTemp

                               Case "Activity", "Activit?", "ACT", "Par", "Paragraph", "Paragraphe", "Paragraaf":
                                  sTemp = cAB.Activity
                                  If SetCellValue(ActiveCell, sTemp) Then sValue = sTemp

                               Case "EconomicCode", "SEC1", "Code SEC 1", "ESR Code 1":
                                  sTemp = cAB.EconomicCode
                                  If SetCellValue(ActiveCell, sTemp) Then sValue = sTemp
                                  On Error Resume Next: ActiveCell.NumberFormat = "00": Err.Clear: On Error GoTo 0

                               Case "CodeSEC", "SEC2", "Code SEC 2", "ESR Code 2":
                                  sTemp = cAB.CodeSEC
                                  If SetCellValue(ActiveCell, sTemp) Then sValue = sTemp
                                  On Error Resume Next: ActiveCell.NumberFormat = "00": Err.Clear: On Error GoTo 0

                               Case "OrderNumber", "NO", "N? d'ord.", "Ord. nummer":
                                  sTemp = cAB.OrderNumber
                                  If SetCellValue(ActiveCell, sTemp) Then sValue = sTemp
                                  On Error Resume Next: ActiveCell.NumberFormat = "00": Err.Clear: On Error GoTo 0

                               Case "Littera", "LIT":
                                  sTemp = cAB.Littera
                                  If SetCellValue(ActiveCell, sTemp) Then sValue = sTemp
                                  On Error Resume Next:
                                  If (Len(sValue) = 2) Then ActiveCell.NumberFormat = "00"
                                  Err.Clear
                                  On Error GoTo 0

                               Case Else:

                                  If Not bOpenedConnection Then
                                     Call eXLBudget_ClickGo.clsData.Conn_Open
                                     bOpenedConnection = True
                                     bFirst = True
                                  End If

                                  ' Fire the queries only once for a single AB

                                  If (sOldABKey <> sABKey) Then

                                     If (bGetBistel) Then

                                        ' Get from Bistel since the requested field is a long text (FR1 till FR9 and the same for NL1 till NL9)

                                        sSQL = "EXEC [eXL].[usp_GetBistel] '" &amp; cAB.BudgetYear &amp; "', " &amp; cAB.BudgetType &amp; ", " &amp; _
                                           "'" &amp; cAB.SPF &amp; "', '" &amp; cAB.OrganicDivision &amp; "', '" &amp; cAB.Program &amp; "', '" &amp; cAB.Activity &amp; "', " &amp; _
                                           "'" &amp; cAB.EconomicCode &amp; "', '" &amp; cAB.CodeSEC &amp; "', '" &amp; cAB.OrderNumber &amp; "', '" &amp; cAB.Littera &amp; "'"

                                        Set rsBistel = eXLBudget_ClickGo.clsData.GetRecordSet(sSQL)

                                     End If ' If (rsBistel Is Nothing) Then

                                     ' Execute a query on the database once by AB : don't fire the query more than once for the same AB when the user ask more than one file

                                     ' The ending "1" in the SQL call means AddText : the query should return the FR/NL text for that AB
                                     sSQL = "EXEC [eXL].[usp_GetFigures] '" &amp; cAB.BudgetYear &amp; "', " &amp; cAB.BudgetType &amp; ", " &amp; _
                                        cAB.BudgetCycle &amp; ", '" &amp; cAB.SPF &amp; "', '" &amp; cAB.OrganicDivision &amp; "', '" &amp; cAB.Program &amp; "', '" &amp; cAB.Activity &amp; "', " &amp; _
                                        "'" &amp; cAB.EconomicCode &amp; "', '" &amp; cAB.CodeSEC &amp; "', '" &amp; cAB.OrderNumber &amp; "', '" &amp; cAB.Littera &amp; _
                                        "', " &amp; cAB.PhaseNumber &amp; ", '" &amp; CAVO_AddIn.cUser.Name &amp; "', 0, 0"

                                     Set rs = eXLBudget_ClickGo.clsData.GetRecordSet(sSQL)

                                     ' Remember the processed AB so we'll no more fire queries for the same AB

                                     sOldABKey = sABKey

                                  End If ' If (sOldABKey <> sABKey) Then

                                  ' Default value
                                  sValue = cNotFound

                                  ' Optimization : avoid a call to in_array.   If rsBistel is not empty, try to find any field (even vkinit) in it.
                                  ' This is faster than making a call to

                                  If Not (rsBistel Is Nothing) Then
                                     On Error Resume Next
                                     sValue = IIf(IsNull(rsBistel.Fields(sFieldName).Value), cNotFound, rsBistel.Fields(sFieldName).Value)
                                     Err.Clear
                                     On Error GoTo 0
                                  End If

                                  If (sValue = cNotFound) Then

                                     ' Other field; comes from dbo.AB

                                     If Not (rs Is Nothing) Then

                                        If Not rs.EOF Then

                                           On Error Resume Next

                                           sValue = IIf(IsNull(rs.Fields(sFieldName).Value), 0, rs.Fields(sFieldName).Value)

                                           If (Err.Number <> 0) Then

                                              Call CAVO_AddIn.cApp.Status("Field [" &amp; sFieldName &amp; "] doesn't exists in the eXL database")

                                              sValue = sOldValue

                                              ' In order to optimize speed, remember that this "FieldName" doesn't exists
                                              wFieldsNotFound = wFieldsNotFound + 1
                                              ReDim Preserve arrFieldsNotFound(wFieldsNotFound - 1)
                                              arrFieldsNotFound(wFieldsNotFound - 1) = sFieldName

                                           Else ' If (Err.Number <> 0) Then

                                              If (CAVO_AddIn.cFunctions.in_array(sFieldName, arrFieldsProcessed) = -1) Then

                                                 wFieldsProcessed = wFieldsProcessed + 1
                                                 ReDim Preserve arrFieldsProcessed(wFieldsProcessed - 1)
                                                 arrFieldsProcessed(wFieldsProcessed - 1) = sFieldName

                                                 If bFirst Then
                                                    ' Very first call, get the list of fields from the database.  Do this only once
                                                    If rsFieldList Is Nothing Then Set rsFieldList = eXLBudget_ClickGo.clsData.GetRecordSet(cGetFieldsList)
                                                    bFirst = False
                                                 End If

                                                 ' Get the type of field : text, float, ...
                                                 sType = GetFieldInfo(rsFieldList, sFieldName, "type", "text")

                                                 Set rngProcessedColumn = sh.Range(sh.Cells(wFirstDataRow, wCol), sh.Cells(wLastDataRow, wCol))

                                                 Select Case sType
                                                    Case "Bigint", "Int", "SmallInt", "Tinyint": sFormat = "0"
                                                    Case "Float": sFormat = "#,##0"
                                                    Case "DateTime": sFormat = "dd/mm/yyyy hh:mm"
                                                    Case Else: sFormat = "@"
                                                 End Select

                                                 On Error Resume Next
                                                 rngProcessedColumn.Cells.NumberFormat = sFormat
                                                 Err.Clear
                                                 On Error GoTo 0

                                                 ' Add a comment

                                                 sComment = GetFieldInfo(rsFieldList, sFieldName, "Description", "")

                                                 sComment = IIf(sComment <> "", sComment &amp; Chr(10), "") &amp; wBudgetYear &amp; ", " &amp; IIf(wBudgetType = 0, "Expenses", "Incomes") &amp; _
                                                    ", " &amp; "Cycle " &amp; wBudgetCycle &amp; ", Phase " &amp; wPhaseNumber

                                                 If Not (sh.Cells(wFirstDataRow - 1, wCol).Locked) Then
                                                    Call CAVO_AddIn.cRange.AddComment(sh.Cells(wFirstDataRow - 1, wCol), sComment, False, "Click&amp;Go")
                                                 End If

                                              End If

                                           End If ' If (Err.Number <> 0) Then

                                           On Error GoTo 0

                                        End If ' If Not rs.EOF Then

                                     End If ' If Not (rs Is Nothing) Then

                                  End If ' If (sValue = cNotFound) Then

                                  If (sValue = cNotFound) Then

                                     If Not bchkNotFound Then sValue = sOldValue

                                     Call CAVO_AddIn.cApp.Status("An error has occured while getting the field [" &amp; sFieldName &amp; "] ...")

                                  End If ' If (sValue = cNotFound) Then

                            End Select

                            If (sOldValue <> sValue) Then

                               If bAllowScreenUpdating Then
                                  ' Allow screen updating only on the first column.   Avoid an horizontal scrolling
                                  Application.ScreenUpdating = bAllowScreenUpdating
                                  ' Activate the ... activecell only to allow Excel to display the processed row. Best for user experience.
                                  ActiveCell.Activate
                                  bAllowScreenUpdating = False
                               End If

                               ActiveCell.Value = sValue

                               If (sValue = cNotFound) Then

                                  ' The AB / Article doesn't exists.  No record returned by the query.
                                  On Error Resume Next
                                  Selection.Interior.Color = vbRed
                                  Selection.Font.Color = vbYellow
                                  Err.Clear
                                  On Error GoTo 0

                               ElseIf (bchkHighlight) Then

                                  On Error Resume Next

                                  With Selection.Interior
                                     .Pattern = xlSolid
                                     .PatternColorIndex = xlAutomatic
                                     .Color = 13630930
                                     .TintAndShade = 0
                                     .PatternTintAndShade = 0
                                  End With

                                  Selection.Font.Color = vbBlack

                                  Err.Clear
                                  On Error GoTo 0

                               End If
                               Application.ScreenUpdating = bAllowScreenUpdating

                            End If

                         End If ' If cAB.SPF <> ""

                     End If ' If Not (activecell.Locked) Then

                  End If ' If (IsEmpty(ActiveCell) Or bchkOverwrite) Then

               End If ' If bContinue

            Next wCol

         End If ' If bContinue (Process the row)

      Next ' For Each rngRow In rngData.Rows

      On Error Resume Next
      If Not rs Is Nothing Then rs.Close: Set rs = Nothing
      If Not rsBistel Is Nothing Then rsBistel.Close: Set rsBistel = Nothing
      If Not rsFieldList Is Nothing Then rsFieldList.Close: Set rsFieldList = Nothing
      On Error GoTo 0

      If bOpenedConnection Then Call eXLBudget_ClickGo.clsData.Conn_Close

      Call CAVO_AddIn.cName.Add("_paramBudgetYear", "=" &amp; wBudgetYear, False, sh)
      Call CAVO_AddIn.cName.Add("_paramBudgetCycle", "=" &amp; wBudgetCycle, False, sh)
      Call CAVO_AddIn.cName.Add("_paramPhaseNumber", "=" &amp; wPhaseNumber, False, sh)

      ' Avoid screen flickering

      Application.ScreenUpdating = False

      ' Refresh formula's
      sh.Calculate

      If (bchkAutoFit) Then
         On Error Resume Next
         Call CAVO_AddIn.cRange.AutoFit(sh:=sh, autofitcolumns:=True)
         Err.Clear
         On Error GoTo 0
      End If

   Else

      Call cAB.ABKeyFieldsMissing

   End If

   sh.EnableSelection = xlSelect
   Application.EnableEvents = bEnableEvents
   Application.ScreenUpdating = bScreenUpdating

   Set rng = Nothing
   Set rngData = Nothing
   Set rngRow = Nothing
   Set sh = Nothing

End Sub

Public Sub clickExpandRange(control As IRibbonControl)

Dim rng As Range

   Set rng = ActiveCell.CurrentRegion
   If (rng.Cells.Count = 1) Then Set rng = rng.End(xlToLeft).CurrentRegion

   Set rng = CAVO_AddIn.cRange.ConfirmRange("", rng.CurrentRegion)

   If Not rng Is Nothing Then
      Call CAVO_AddIn.cName.Add("_dsData", "='" &amp; rng.Parent.Name &amp; "'!" &amp; rng.Address, True, rng.Parent)
      'Call Helper.ShowInfo("The range has been updated, you can now use the 'Fill in' functionnality")
   End If

End Sub

Public Sub clickFieldList(control As IRibbonControl)
   Call GetFieldsList
End Sub

Public Sub GetFieldsList()

Dim sColumn As String, sFieldName As String, sFormula As String
Dim bEvents As Boolean, bScreenUpdating As Boolean, bAlerts As Boolean
Dim sh As Worksheet
Dim wb As Workbook
Dim I As Integer, J As Integer
Dim wFirstDataColumn As Byte, wFirstDataRow As Byte, wLastDataRow As Long, wLastDataColumn As Long
Dim wRow As Byte
Dim rng As Range, rngData As Range
Dim cols As ABKey_Columns

   bEvents = Application.EnableEvents
   bScreenUpdating = Application.ScreenUpdating

   Application.EnableEvents = False
   Application.ScreenUpdating = False

   Call eXLBudget_ClickGo.clsData.Conn_Open
   Set rs = eXLBudget_ClickGo.clsData.GetRecordSet(cGetFieldsList)

   Set wb = Nothing

   If Not (ActiveWorkbook Is Nothing) Then
      If Not ActiveWorkbook.ProtectStructure Then
         Set wb = ActiveWorkbook
      End If
   End If

   If (wb Is Nothing) Then

      Set wb = Application.Workbooks.Add
      Set sh = ActiveWorkbook.Worksheets(1)

      bAlerts = Application.DisplayAlerts
      Application.DisplayAlerts = False
      If (CAVO_AddIn.cSheet.Exists("Sheet2", wb)) Then Call CAVO_AddIn.cSheet.Delete("Sheet2", wb)
      If (CAVO_AddIn.cSheet.Exists("Sheet3", wb)) Then Call CAVO_AddIn.cSheet.Delete("Sheet3", wb)
      Application.DisplayAlerts = bAlerts

   Else
      Set sh = wb.Worksheets.Add
   End If

   wFirstDataColumn = 1
   wFirstDataRow = 2

   ' Output fieldsname

   J = rs.Fields.Count - 1

   For I = 0 To J
       sh.Cells(wFirstDataRow, I + wFirstDataColumn).Value = rs.Fields(I).Name
   Next

   ' Output data

   sh.Cells(wFirstDataRow + 1, wFirstDataColumn).CopyFromRecordset rs

   Call eXLBudget_ClickGo.clsData.Conn_Close

   wLastDataRow = sh.UsedRange.Rows.Count + wFirstDataRow - 1
   wLastDataColumn = sh.UsedRange.Columns.Count

   ' Give a name to the range; columns by columns and hide unneeded ones

   For I = 0 To J

      sFieldName = sh.Cells(wFirstDataRow, I + wFirstDataColumn).Value
      ' Don't take the first row (field's title); only data
      Set rng = sh.Range(sh.Cells(wFirstDataRow + 1, I + wFirstDataColumn), sh.Cells(wLastDataRow, I + wFirstDataColumn))

      Call CAVO_AddIn.cName.Add("_rng" &amp; sFieldName, "='" &amp; sh.Name &amp; "'!" &amp; rng.Address, True, sh, sh.Parent)
      If (CAVO_AddIn.cFunctions.in_array(sFieldName, Array("FieldName", "Description")) = -1) Then rng.EntireColumn.Hidden = True

   Next

   ' Remove records (fields) where the description is "Unused".  Only keep the used fields from the dbo.AB table
   Set rng = CAVO_AddIn.cRange.FindAll("Unused", Range("_rngDescription"), xlValues, xlPart)
   If Not rng Is Nothing Then
      On Error Resume Next
      rng.EntireRow.Delete
      On Error GoTo 0
   End If

   ' Add autofilters
   sh.Cells(wFirstDataRow, wFirstDataColumn).AutoFilter

   Call CAVO_AddIn.cWindow.NiceDisplay

   sh.Cells(wFirstDataRow + 1, wFirstDataColumn).Select
   ActiveWindow.FreezePanes = True

   Call CAVO_AddIn.cRange.AutoFit(sh:=sh, autofitcolumns:=True)

   ' Try to give a name to the sheet
   On Error Resume Next
   sh.Name = "FieldList"
   On Error GoTo 0

   Application.EnableEvents = bEvents
   Application.ScreenUpdating = bScreenUpdating

   Set sh = Nothing
   Set wb = Nothing

End Sub

' -------------------------------------------------------------------------------------------
'
' Scan the Excel sheet and found any part of the key (SPF, Division, Program, ...) and a few others infos (optional)
' like BudgetYear, BudgetCycle, BudgetType and PhaseNumber.
'
' When found, continue the scan and find any other columns that is present (f.i. CRIP, Code, DC, Ministre, ...).
'
' When this is done, loop any records and prepare an UPDATE SQL STATEMENT so a developper can immediatly fire this statement
' against the database
'
' -------------------------------------------------------------------------------------------

Private Sub ProcessDataRange(ByVal sType As String)

Dim sh As Worksheet
Dim rng As Range, rngData As Range, rngRow As Range, rngSQL As Range, rngLastCell As Range
Dim sTemp As String, sReportTitle As String
Dim sResultSQL As String
Dim wRow As Long
Dim cClipboard As Object

   sResultSQL = ""

   If (ActiveSheet Is Nothing) Then
      Call Helper.ShowError("Please first open a workbook")
      Exit Sub
   End If

   Set rng = Nothing

   If (Selection.Cells.Count > 1) Then
      If (MsgBox("Use the current selection (" &amp; Selection.Address &amp; ") ? ", vbQuestion + vbYesNo) = vbYes) Then
         Set rng = Selection
      End If
   End If

   Set sh = ActiveSheet

   If (CAVO_AddIn.cName Is Nothing) Then Call CAVO_AddIn.Main.Initialize

   If (CAVO_AddIn.cName.Exists("_dsData")) Then Set rng = ActiveSheet.Range("_dsData")

   ' Full range; including the field's name
   If (rng Is Nothing) Then
      Set rng = ActiveSheet.UsedRange

      If rng Is Nothing Then
         Call Helper.ShowError("The sheet is empty")
         Exit Sub
      End If

      ' Get the bottom right cell of the used range.   And, for that cell, take the region.  Doing this will select the data table
      Set rngLastCell = rng.Cells(rng.Rows.Count, rng.Columns.Count)
      Set rng = rngLastCell.CurrentRegion
      If (rng.Cells.Count = 1) Then
         Set rng = rng.End(xlToLeft).CurrentRegion
      End If
   End If

   If (Left(sType, 4) = "SQL_") Then

      'Set rngSQL = Nothing
      'If (CAVO_AddIn.cName.Exists("_rngSQL", sh)) Then
      '   On Error Resume Next
      '   Set rngSQL = sh.Range("_rngSQL")
      '   If Err.Number <> 0 Then Set rngSQL = Nothing
      '   On Error GoTo 0
      'End If
      '
      'If (rngSQL Is Nothing) Then
      '   Set rngSQL = sh.Range(rng.Cells(2, rng.Columns.Count + 1), rng.Cells(rng.Rows.Count, rng.Columns.Count + 1))
      '   Call CAVO_AddIn.cName.Add("_rngSQL", "='" &amp; sh.Name &amp; "'!" &amp; rngSQL.Address, True, sh, sh.Parent)
      '   rngSQL.Offset(-1).Cells(1, 1).Value = "SQL"
      'End If

   End If

   ' Data range; excluding the field's name; resize as from row 2 of the range
   Set rngData = CAVO_AddIn.cRange.Resize(rng, 2)

   Call cAB.SetDataRange(rng)
   Call cAB.GetABCols

   If (cAB.ABKeyFieldsPresent) Then

      ' sType = "SQL_xxx" when the AddIn should generate SQL statements.  This has no sense to do this
      ' for each AB of the sheet.   Only the row where the user has right-clicked should be processed

      'wRow = IIf(Left(sType, 4) = "SQL_", 1, Selection.Row - 1)
      ' Should be relative to rng.
      wRow = Selection.Row - rng.Row

      For Each rngRow In rng.Rows

        ' Get the row to process : ony by one
         cAB.Row = rngRow.Row

         If cAB.SPF <> "" Then

            If (sType = "SQL_UPDATE") Then

               ' Update statement
               sSQL = "UPDATE dbo.AB SET " &amp; cAB.GetExtraColumns &amp; " FROM dbo.AB WHERE " &amp; cAB.WhereClause

            ElseIf (sType = "SQL_FIGURES") Or (sType = "DUMP_FIGURES") Then

               ' Get last figures
               sSQL = "EXEC [eXL].[usp_GetFigures] '" &amp; cAB.BudgetYear &amp; "','" &amp; cAB.BudgetType &amp; "','" &amp; cAB.BudgetCycle &amp; "'," &amp; _
                  "'" &amp; cAB.SPF &amp; "','" &amp; cAB.OrganicDivision &amp; "','" &amp; cAB.Program &amp; "','" &amp; cAB.Activity &amp; "'," &amp; _
                  "'" &amp; cAB.EconomicCode &amp; "','" &amp; cAB.CodeSEC &amp; "','" &amp; cAB.OrderNumber &amp; "'," &amp; _
                  "'" &amp; cAB.Littera &amp; "','" &amp; cAB.PhaseNumber &amp; "','" &amp; CAVO_AddIn.cUser.Name &amp; "',0,0"

               sReportTitle = "Extract for " &amp; cAB.ABKey &amp; " - BudgetYear " &amp; cAB.BudgetYear &amp; " - BudgetCycle " &amp; cAB.BudgetCycle &amp; " - PhaseNumber " &amp; cAB.PhaseNumber

            ElseIf (sType = "SQL_FROMAB") Then

               ' Get last figures
                sSQL = "SELECT * FROM dbo.AB WHERE " &amp; cAB.WhereClause

            ElseIf (sType = "DUMP_Versioning") Then

               ' List of changes on that AB
               sSQL = "EXEC [eXL].[usp_GetVersioning] '%','" &amp; cAB.BudgetYear &amp; "','" &amp; cAB.BudgetType &amp; "'," &amp; _
                  "'" &amp; cAB.BudgetCycle &amp; "','" &amp; cAB.SPF &amp; "','" &amp; cAB.OrganicDivision &amp; "','" &amp; cAB.Program &amp; "'," &amp; _
                  "'" &amp; cAB.Activity &amp; "','" &amp; cAB.EconomicCode &amp; "','" &amp; cAB.CodeSEC &amp; "','" &amp; cAB.OrderNumber &amp; "'," &amp; _
                  "'" &amp; cAB.Littera &amp; "'"

               sReportTitle = "History of " &amp; cAB.ABKey &amp; " - BudgetYear " &amp; cAB.BudgetYear

            End If

            If CAVO_AddIn.cDebug.Enabled Then Call CAVO_AddIn.cDebug.Log(sSQL, "eXLBudget_Click&amp;Go!Toolbar::ProcessDataRange")

            If (Left(sType, 4) = "SQL_") Then

               ' Output the SQL statement
               'rngSQL.Cells(wRow, 1).Value = sSQL
               sResultSQL = sResultSQL &amp; sSQL &amp; vbCrLf

            Else

               Call eXLBudget_ClickGo.clsData.Conn_Open
               Call CAVO_AddIn.cData.RunSQLAndExportNewWorkbook(sSQL, sReportTitle)
               Call eXLBudget_ClickGo.clsData.Conn_Close

               Exit For

            End If

         End If ' If cAB.SPF <> ""

         'wRow = wRow + 1

      Next

      ' Refresh formula's
      sh.Calculate

      If (Left(sType, 4) = "SQL_") Then
         'rngSQL.Select

         CAVO_AddIn.cClipboard.SetText sResultSQL

         MsgBox "SQL statements have been copied in the clipboard", vbInformation, "eXLBudget_Click&amp;Go"

      End If

   Else

      Call cAB.ABKeyFieldsMissing

   End If

   Set rng = Nothing
   Set rngData = Nothing
   Set rngRow = Nothing
   Set sh = Nothing

End Sub

Public Sub SQL_Update()
   Call ProcessDataRange("SQL_Update")
End Sub

Public Sub SQL_GetFigures()
   Call ProcessDataRange("SQL_Figures")
End Sub

Public Sub SQL_GetFromAB()
   Call ProcessDataRange("SQL_FromAB")
End Sub

Public Sub Dump_GetFigures()
   Call ProcessDataRange("Dump_Figures")
End Sub

Public Sub Dump_GetHistory()
   Call ProcessDataRange("Dump_Versioning")
End Sub

' -------------------------------------------------------------------------------------
'
' Add the Click&amp;Go contextual menu in the "Right-clic" menu of the worksheet
'
' -------------------------------------------------------------------------------------

Public Sub AddContextualMenuToCellMenu()

Dim cmdContextMenu As CommandBar
Dim ctrlClickGo As CommandBarControl
Dim sUserName As String

   On Error Resume Next
   ' Get the connected username
   sUserName = CAVO_AddIn.cUser.Name
   Err.Clear
   On Error GoTo 0

    ' Delete the controls first to avoid duplicates.
    Call RemoveContextualMenuFromCellMenu

    ' Set ContextMenu to the Cell context menu.
    Set cmdContextMenu = Application.CommandBars("Cell")

    ' Add a custom submenu for Click&amp;Go
    Set ctrlClickGo = cmdContextMenu.Controls.Add(Type:=msoControlPopup, before:=1)

    With ctrlClickGo

        .Caption = "Click&amp;&amp;Go"
        .Tag = "ClickGo_Tag"

        ' ------------------------------------------------------------------
        ' Only for developer

        If (sUserName = "YOURICT\avonture_christophe") Then
            With .Controls.Add(Type:=msoControlButton)
               .OnAction = "'" &amp; ThisWorkbook.Name &amp; "'!" &amp; "SQL_Update"
               .FaceId = 4014
               .Caption = "Update statement"
           End With
           With .Controls.Add(Type:=msoControlButton)
               .OnAction = "'" &amp; ThisWorkbook.Name &amp; "'!" &amp; "SQL_GetFigures"
               .FaceId = 4014
               .Caption = "Get last figures from dbo.AB (usp_GetFigures)"
           End With
           With .Controls.Add(Type:=msoControlButton)
               .OnAction = "'" &amp; ThisWorkbook.Name &amp; "'!" &amp; "SQL_GetFromAB"
               .FaceId = 4014
               .Caption = "SELECT * FROM dbo.AB"
           End With
        End If ' If (sUserName = "YOURICT\avonture_christophe") Then

        ' ------------------------------------------------------------------
        ' For every users - run SQL and export recordset into a new workbook

        With .Controls.Add(Type:=msoControlButton)
            .BeginGroup = True
            .OnAction = "'" &amp; ThisWorkbook.Name &amp; "'!" &amp; "Dump_GetFigures"
            .FaceId = 142
            .Caption = "Get a dump for this AB/article"
        End With

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" &amp; ThisWorkbook.Name &amp; "'!" &amp; "Dump_GetHistory"
            .FaceId = 142
            .Caption = "Get history of changes for this AB/article"
        End With

    End With

    ' Add a separator between the Click&amp;Go menu and the Excel standard menu
    cmdContextMenu.Controls(2).BeginGroup = True

End Sub

' -------------------------------------------------------------------------------------
'
' Remove the Click&amp;Go contextual menu from "Right-clic" menu of the worksheet
'
' -------------------------------------------------------------------------------------

Public Sub RemoveContextualMenuFromCellMenu()

Dim cmdContextMenu As CommandBar
Dim ctrl As CommandBarControl

   Set cmdContextMenu = Application.CommandBars("Cell")

   ' Delete the custom controls with the Tag : My_Cell_Control_Tag.
   For Each ctrl In cmdContextMenu.Controls
      If ctrl.Tag = "ClickGo_Tag" Then ctrl.Delete
   Next ctrl

End Sub