Add VBA source code for GitHub visibility
This commit is contained in:
parent
c71c19ec03
commit
ed451a6e8a
20
src/ThisWorkbook.cls
Normal file
20
src/ThisWorkbook.cls
Normal file
@ -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
|
||||
76
src/mod_Charts.bas
Normal file
76
src/mod_Charts.bas
Normal file
@ -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
|
||||
145
src/mod_Design.bas
Normal file
145
src/mod_Design.bas
Normal file
@ -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
|
||||
92
src/mod_Refresh.bas
Normal file
92
src/mod_Refresh.bas
Normal file
@ -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
|
||||
94
src/mod_Slicers.bas
Normal file
94
src/mod_Slicers.bas
Normal file
@ -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
|
||||
99
src/mod_TCD.bas
Normal file
99
src/mod_TCD.bas
Normal file
@ -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
|
||||
Loading…
Reference in New Issue
Block a user