From ed451a6e8ab6ab83254bd3bf67316cbac2d6a425 Mon Sep 17 00:00:00 2001 From: StillHammer Date: Tue, 30 Dec 2025 16:52:52 +0700 Subject: [PATCH] Add VBA source code for GitHub visibility --- src/ThisWorkbook.cls | 20 ++++++ src/mod_Charts.bas | 76 +++++++++++++++++++++++ src/mod_Design.bas | 145 +++++++++++++++++++++++++++++++++++++++++++ src/mod_Refresh.bas | 92 +++++++++++++++++++++++++++ src/mod_Slicers.bas | 94 ++++++++++++++++++++++++++++ src/mod_TCD.bas | 99 +++++++++++++++++++++++++++++ 6 files changed, 526 insertions(+) create mode 100644 src/ThisWorkbook.cls create mode 100644 src/mod_Charts.bas create mode 100644 src/mod_Design.bas create mode 100644 src/mod_Refresh.bas create mode 100644 src/mod_Slicers.bas create mode 100644 src/mod_TCD.bas diff --git a/src/ThisWorkbook.cls b/src/ThisWorkbook.cls new file mode 100644 index 0000000..7b1585d --- /dev/null +++ b/src/ThisWorkbook.cls @@ -0,0 +1,20 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "ThisWorkbook" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = True +Option Explicit + +' ============================================================================= +' ThisWorkbook Module +' Description: Auto-refresh on workbook open +' ============================================================================= + +Private Sub Workbook_Open() + ' Automatic refresh when workbook opens + QuickRefresh +End Sub diff --git a/src/mod_Charts.bas b/src/mod_Charts.bas new file mode 100644 index 0000000..4f078a5 --- /dev/null +++ b/src/mod_Charts.bas @@ -0,0 +1,76 @@ +Attribute VB_Name = "mod_Charts" +Option Explicit + +' ============================================================================= +' Module: mod_Charts +' Description: Creates Charts for the Freelance Dashboard +' ============================================================================= + +Sub CreateCharts() + Dim wsDash As Worksheet + Dim wsTCD As Worksheet + Dim cht As ChartObject + + On Error GoTo ErrorHandler + + Set wsDash = ThisWorkbook.Sheets("Dashboard") + Set wsTCD = ThisWorkbook.Sheets("TCD_Data") + + ' Delete existing charts + On Error Resume Next + For Each cht In wsDash.ChartObjects + cht.Delete + Next cht + On Error GoTo ErrorHandler + + ' Chart 1: Pie Chart - Revenue by Client + Set cht = wsDash.ChartObjects.Add( _ + Left:=wsDash.Range("D3").Left, _ + Top:=wsDash.Range("D3").Top, _ + Width:=250, _ + Height:=200) + + With cht.Chart + .SetSourceData Source:=wsTCD.PivotTables("TCD_CA_Client").TableRange1 + .ChartType = xlPie + .HasTitle = True + .ChartTitle.Text = "CA par Client" + .HasLegend = True + .Legend.Position = xlLegendPositionRight + End With + + ' Chart 2: Column Chart - Revenue by Month + Set cht = wsDash.ChartObjects.Add( _ + Left:=wsDash.Range("D12").Left, _ + Top:=wsDash.Range("D12").Top, _ + Width:=250, _ + Height:=200) + + With cht.Chart + .SetSourceData Source:=wsTCD.PivotTables("TCD_CA_Mois").TableRange1 + .ChartType = xlColumnClustered + .HasTitle = True + .ChartTitle.Text = "CA par Mois" + .HasLegend = False + End With + + ' Chart 3: Bar Chart - Hours by Project + Set cht = wsDash.ChartObjects.Add( _ + Left:=wsDash.Range("H3").Left, _ + Top:=wsDash.Range("H3").Top, _ + Width:=250, _ + Height:=200) + + With cht.Chart + .SetSourceData Source:=wsTCD.PivotTables("TCD_Heures_Projet").TableRange1 + .ChartType = xlBarClustered + .HasTitle = True + .ChartTitle.Text = "Heures par Projet" + .HasLegend = False + End With + + Exit Sub + +ErrorHandler: + MsgBox "Error creating charts: " & Err.Description, vbCritical, "Error" +End Sub diff --git a/src/mod_Design.bas b/src/mod_Design.bas new file mode 100644 index 0000000..3ba41df --- /dev/null +++ b/src/mod_Design.bas @@ -0,0 +1,145 @@ +Attribute VB_Name = "mod_Design" +Option Explicit + +' ============================================================================= +' Module: mod_Design +' Description: Applies professional design to the Dashboard +' Color Palette: +' - Primary (Blue): #2C3E50 / RGB(44, 62, 80) +' - Accent (Green): #27AE60 / RGB(39, 174, 96) +' - Neutral (Gray): #ECF0F1 / RGB(236, 240, 241) +' - Alert (Red): #E74C3C / RGB(231, 76, 60) +' ============================================================================= + +Sub ApplyDesign() + Dim wsDash As Worksheet + + On Error GoTo ErrorHandler + + Set wsDash = ThisWorkbook.Sheets("Dashboard") + + ' Colors + Dim bleuFonce As Long, vert As Long, grisClair As Long, rouge As Long + bleuFonce = RGB(44, 62, 80) + vert = RGB(39, 174, 96) + grisClair = RGB(236, 240, 241) + rouge = RGB(231, 76, 60) + + ' Euro symbol + Dim euroSymbol As String + euroSymbol = Chr(128) + + With wsDash + ' Hide gridlines + ActiveWindow.DisplayGridlines = False + + ' Light gray background + .Cells.Interior.Color = grisClair + + ' Dashboard Title (A1:C1) + .Range("A1:C1").Merge + With .Range("A1") + .Font.Name = "Calibri" + .Font.Size = 24 + .Font.Bold = True + .Font.Color = bleuFonce + .HorizontalAlignment = xlLeft + .VerticalAlignment = xlCenter + .RowHeight = 40 + End With + + ' Section header "KPIs Principaux" (A3) + With .Range("A3") + .Font.Name = "Calibri" + .Font.Size = 14 + .Font.Bold = True + .Font.Color = bleuFonce + End With + + ' KPI Labels (A4:A9) + With .Range("A4:A9") + .Font.Name = "Calibri" + .Font.Size = 11 + .Font.Color = bleuFonce + End With + + ' KPI Values (B4:B9) + With .Range("B4:B9") + .Font.Name = "Calibri" + .Font.Size = 16 + .Font.Bold = True + .Font.Color = bleuFonce + .HorizontalAlignment = xlRight + End With + + ' Number formats + .Range("B4").NumberFormat = "# ##0 [$" & euroSymbol & "-40C]" + .Range("B5").NumberFormat = "# ##0 [$" & euroSymbol & "-40C]" + .Range("B6").NumberFormat = "0.0 ""h""" + .Range("B7").NumberFormat = "0.00 [$" & euroSymbol & "-40C]""/h""" + .Range("B8").NumberFormat = "0" + .Range("B9").NumberFormat = "0.0 ""h""" + + ' Top Client (A11:B11) + With .Range("A11") + .Font.Name = "Calibri" + .Font.Size = 11 + .Font.Color = bleuFonce + End With + With .Range("B11") + .Font.Name = "Calibri" + .Font.Size = 14 + .Font.Bold = True + .Font.Color = vert + End With + + ' Statistics Section (A13:B16) + With .Range("A13") + .Font.Name = "Calibri" + .Font.Size = 14 + .Font.Bold = True + .Font.Color = bleuFonce + End With + .Range("A14:A16").Font.Color = bleuFonce + .Range("B14:B16").Font.Bold = True + .Range("B14:B15").NumberFormat = "DD/MM/YYYY" + + ' Column widths + .Columns("A").ColumnWidth = 25 + .Columns("B").ColumnWidth = 18 + .Columns("C").ColumnWidth = 3 + .Columns("D:G").ColumnWidth = 12 + .Columns("H:J").ColumnWidth = 12 + .Columns("K:L").ColumnWidth = 15 + + ' Light borders around KPIs + With .Range("A4:B9").Borders + .LineStyle = xlContinuous + .Weight = xlThin + .Color = RGB(189, 195, 199) + End With + + With .Range("A11:B11").Borders + .LineStyle = xlContinuous + .Weight = xlThin + .Color = RGB(189, 195, 199) + End With + + With .Range("A14:B16").Borders + .LineStyle = xlContinuous + .Weight = xlThin + .Color = RGB(189, 195, 199) + End With + + ' Row heights + .Rows("1").RowHeight = 40 + .Rows("2").RowHeight = 10 + .Rows("3:16").RowHeight = 22 + End With + + MsgBox "Design applied successfully!", vbInformation + Exit Sub + +ErrorHandler: + MsgBox "Error applying design: " & Err.Description, vbCritical, "Error" +End Sub diff --git a/src/mod_Refresh.bas b/src/mod_Refresh.bas new file mode 100644 index 0000000..866de60 --- /dev/null +++ b/src/mod_Refresh.bas @@ -0,0 +1,92 @@ +Attribute VB_Name = "mod_Refresh" +Option Explicit + +' ============================================================================= +' Module: mod_Refresh +' Description: Main refresh and rebuild macros for the Dashboard +' ============================================================================= + +Sub RefreshDashboard() + ' Main refresh macro - recalculates formulas and refreshes pivot tables + Application.ScreenUpdating = False + Application.Calculation = xlCalculationManual + + On Error GoTo ErrorHandler + + ' 1. Recalculate all formulas + Application.CalculateFull + + ' 2. Refresh all Pivot Tables + Dim ws As Worksheet + Dim pt As PivotTable + + For Each ws In ThisWorkbook.Worksheets + For Each pt In ws.PivotTables + pt.RefreshTable + Next pt + Next ws + + ' 3. Refresh external connections (if any) + On Error Resume Next + Dim conn As WorkbookConnection + For Each conn In ThisWorkbook.Connections + conn.Refresh + Next conn + On Error GoTo ErrorHandler + + Application.Calculation = xlCalculationAutomatic + Application.ScreenUpdating = True + + MsgBox "Dashboard refreshed!" & vbCrLf & _ + "- Formulas recalculated" & vbCrLf & _ + "- Pivot tables updated", vbInformation, "Refresh Complete" + Exit Sub + +ErrorHandler: + Application.Calculation = xlCalculationAutomatic + Application.ScreenUpdating = True + MsgBox "Error during refresh: " & Err.Description, vbCritical, "Error" +End Sub + +Sub QuickRefresh() + ' Silent refresh without message box + On Error GoTo ErrorHandler + + Application.ScreenUpdating = False + Application.CalculateFull + + Dim ws As Worksheet + Dim pt As PivotTable + For Each ws In ThisWorkbook.Worksheets + For Each pt In ws.PivotTables + pt.RefreshTable + Next pt + Next ws + + Application.ScreenUpdating = True + Exit Sub + +ErrorHandler: + Application.ScreenUpdating = True +End Sub + +Sub RebuildAll() + ' Rebuilds entire dashboard from scratch + On Error GoTo ErrorHandler + + Application.ScreenUpdating = False + + ' Call other macros + CreatePivotTables + CreateCharts + CreateSlicers + ApplyDesign + + Application.ScreenUpdating = True + MsgBox "Dashboard rebuilt entirely!", vbInformation + Exit Sub + +ErrorHandler: + Application.ScreenUpdating = True + MsgBox "Error during rebuild: " & Err.Description, vbCritical, "Error" +End Sub diff --git a/src/mod_Slicers.bas b/src/mod_Slicers.bas new file mode 100644 index 0000000..6cda74b --- /dev/null +++ b/src/mod_Slicers.bas @@ -0,0 +1,94 @@ +Attribute VB_Name = "mod_Slicers" +Option Explicit + +' ============================================================================= +' Module: mod_Slicers +' Description: Creates Slicers for interactive filtering +' ============================================================================= + +Sub CreateSlicers() + Dim wsDash As Worksheet + Dim wsTCD As Worksheet + Dim sc As SlicerCache + Dim sl As Slicer + Dim pt As PivotTable + + On Error GoTo ErrorHandler + + Set wsDash = ThisWorkbook.Sheets("Dashboard") + Set wsTCD = ThisWorkbook.Sheets("TCD_Data") + + ' Delete existing slicers + On Error Resume Next + Dim existingSC As SlicerCache + For Each existingSC In ThisWorkbook.SlicerCaches + existingSC.Delete + Next existingSC + On Error GoTo ErrorHandler + + ' Slicer 1: ClientID on TCD_CA_Client + Set pt = wsTCD.PivotTables("TCD_CA_Client") + + Set sc = ThisWorkbook.SlicerCaches.Add2( _ + pt, _ + "ClientID", _ + "Slicer_ClientID") + + Set sl = sc.Slicers.Add( _ + wsDash, _ + , _ + "ClientID", _ + "Client", _ + wsDash.Range("K1").Left, _ + wsDash.Range("K1").Top, _ + 150, _ + 180) + + sl.Style = "SlicerStyleLight1" + + ' Connect slicer to other pivot tables + On Error Resume Next + sc.PivotTables.AddPivotTable wsTCD.PivotTables("TCD_CA_Mois") + On Error GoTo ErrorHandler + + ' Slicer 2: Date on TCD_CA_Mois + Set pt = wsTCD.PivotTables("TCD_CA_Mois") + + On Error Resume Next + Set sc = ThisWorkbook.SlicerCaches.Add2( _ + pt, _ + "Date", _ + "Slicer_Date") + + If Not sc Is Nothing Then + Set sl = sc.Slicers.Add( _ + wsDash, _ + , _ + "Date", _ + "Periode", _ + wsDash.Range("K10").Left, _ + wsDash.Range("K10").Top, _ + 150, _ + 150) + + sl.Style = "SlicerStyleLight2" + End If + On Error GoTo ErrorHandler + + MsgBox "Slicers created successfully!", vbInformation + Exit Sub + +ErrorHandler: + MsgBox "Error creating slicers: " & Err.Description, vbCritical, "Error" +End Sub + +Sub ClearSlicerFilters() + ' Clears all slicer filters + Dim sc As SlicerCache + + On Error Resume Next + For Each sc In ThisWorkbook.SlicerCaches + sc.ClearManualFilter + Next sc + On Error GoTo 0 +End Sub diff --git a/src/mod_TCD.bas b/src/mod_TCD.bas new file mode 100644 index 0000000..d14ad5f --- /dev/null +++ b/src/mod_TCD.bas @@ -0,0 +1,99 @@ +Attribute VB_Name = "mod_TCD" +Option Explicit + +' ============================================================================= +' Module: mod_TCD +' Description: Creates Pivot Tables for the Freelance Dashboard +' ============================================================================= + +Sub CreatePivotTables() + Dim ws As Worksheet + Dim pt As PivotTable + Dim pc As PivotCache + + On Error GoTo ErrorHandler + + ' Create TCD sheet if it doesn't exist + On Error Resume Next + Set ws = ThisWorkbook.Sheets("TCD_Data") + On Error GoTo ErrorHandler + + If ws Is Nothing Then + Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) + ws.Name = "TCD_Data" + End If + + ' Clear the sheet + ws.Cells.Clear + + ' TCD 1: Revenue by Client + Set pc = ThisWorkbook.PivotCaches.Create( _ + SourceType:=xlDatabase, _ + SourceData:="tbl_Revenus") + + Set pt = pc.CreatePivotTable( _ + TableDestination:=ws.Range("A1"), _ + TableName:="TCD_CA_Client") + + With pt + .PivotFields("ClientID").Orientation = xlRowField + .PivotFields("ClientID").Position = 1 + With .PivotFields("Montant") + .Orientation = xlDataField + .Function = xlSum + .NumberFormat = "# ##0 $" + .Name = "CA Total" + End With + End With + + ' TCD 2: Revenue by Month + Set pt = pc.CreatePivotTable( _ + TableDestination:=ws.Range("E1"), _ + TableName:="TCD_CA_Mois") + + With pt + .PivotFields("Date").Orientation = xlRowField + .PivotFields("Date").Position = 1 + With .PivotFields("Montant") + .Orientation = xlDataField + .Function = xlSum + .NumberFormat = "# ##0 $" + .Name = "CA Mensuel" + End With + End With + + ' Group dates by month and year + On Error Resume Next + pt.PivotFields("Date").DataRange.Cells(1).Group _ + Start:=True, End:=True, _ + Periods:=Array(False, False, False, False, True, False, True) + On Error GoTo ErrorHandler + + ' TCD 3: Hours by Project + Set pc = ThisWorkbook.PivotCaches.Create( _ + SourceType:=xlDatabase, _ + SourceData:="tbl_Temps") + + Set pt = pc.CreatePivotTable( _ + TableDestination:=ws.Range("I1"), _ + TableName:="TCD_Heures_Projet") + + With pt + .PivotFields("Projet").Orientation = xlRowField + .PivotFields("Projet").Position = 1 + With .PivotFields("Heures") + .Orientation = xlDataField + .Function = xlSum + .NumberFormat = "0.0" + .Name = "Total Heures" + End With + End With + + ws.Activate + + MsgBox "3 Pivot Tables created successfully!", vbInformation, "TCD Created" + Exit Sub + +ErrorHandler: + MsgBox "Error creating Pivot Tables: " & Err.Description, vbCritical, "Error" +End Sub