---
title: "Subventions pour l'établissement d'un audit énergétique CECB®Plus"
lang: fr
subtitle: "Nombre de subventions et montants promis, Vaud"
author: "DGE-DIREN"
date: last-modified # Renvoie automatiquement la date de dernière modification du .qmd
params: # ! `open_params_metadata_help()` pour des instructions de remplissage détaillées
fonction: 1 # Valeur numérique : 0=Non-défini/1=Description/2=Orientation/3=Pilotage
nature: 1 # Valeur numérique : 0=Non-défini/1=Actions/2=Effets/3=Impacts
idThematique: 08.05.03.06 # Identifiant selon nomenclature obsind theme/sous-theme/objet/id (p.ex. 08.03.01)
niveauPublication: 2 # Valeur numérique : 0=Non-défini/1=Interne/2=Public. Tout autre choix génère un avertissement
niveauDetail: Subvention # Texte libre qui indique le niveau minimal d'agrégation disponible pour l'indicateur (canton, commune, région, installation, véhicule, etc.)
frequenceMAJ: Annuel # Texte libre, idéalement à choisir parmi les codes suivants : mensuel/semestriel/annuel/biannuel/mensuel/tous les x ans/non-défini
moisMAJ: 2 # Valeur numérique : 0=Non-défini/1=Janvier/2=Février, etc.
disponibleDepuis: 2018 # Valeur numérique Année (aaaa) (p.ex. 2000)
personneReference: "Steve Ducommun" # Prénom+Nom de la personne référente de l'indicateur
mailReference: stat.energie@vd.ch # E-mail ACV (générique ou nominal, se terminant par @vd.ch)
uuid: 9333b763-6549-4fc4-b9b1-91024c90585f # !NE PAS MODIFIER! Identifiant unique généré automatiquement à la création de la fiche
uuidParent: null # Identifiant(s) unique(s) des indicateurs parents de l'indicateur actuel (format uuid avec séparateur '/' si plusieurs uuid)
uuidEnfant: null # Identifiant(s) unique(s) des indicateurs enfants de l'indicateur actuel (format uuid avec séparateur '/' si plusieurs uuid)
uuidConnexe: null # Identifiant(s) unique(s) des indicateurs connexes à l'indicateur actuel (format uuid avec séparateur '/' si plusieurs uuid)
majCatalogue: 1 # Valeur numérique : 0=Non/1=Oui pour mettre à jour les métadonnées dans le catalogue des indicateurs (connexion au disque partagé ObsInd requise)
format:
html:
other-links: # Copier la structure ci-dessous pour remplacer/ajouter d'autres liens sous la table des matières
- text: Infos statistiques énergie
href: 'https://www.vd.ch/environnement/energie/chiffres-cles-et-statistiques-energie-vaud/'
target: '_blank'
- text: Profil climatique communes
href: 'https://stat-climat-vd.ch/profil-climat/'
target: '_blank'
- text: Direction de l'énergie
href: 'https://www.vd.ch/djes/dge/dge-diren'
target: '_blank'
metadata-files: # Ne pas supprimer !
- assets/format-options.yml
editor_options:
chunk_output_type: console
---
<!-- Les métadonnées ci-dessus doivent être remplies pour chaque fiche. Lorsqu'un champ n'est disponible, il est possible d'écrire "" ou NULL -->
<!-- Aide au remplissage : `obsindVD::open_aide_remplissage_help()` (lancer la ligne de code dans la console) -->
```{r setup}
#| echo: false
#| warning: false
#| message: false
#| results: asis
# version: 1.2.2 (01.09.2026)
# -----------------------------------------------------------------------------
# Ne rien modifier dans ce bloc de code !
# Ce bloc doit être lancé pour charger les métadonnées dans l'environnement !
# -----------------------------------------------------------------------------
# update_model_setup_code() pour mettre à jour ce bloc avec la version du dernier modèle
# Chargement (ou installation) des librairies disponibles sur CRAN
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, readxl, glue, gt, DT, ggiraph, scales, ggtext)
# Chargement de la librairie obsindVD privée
# Pour l'installation : suivre les instructions dans le BitBucket : https://dsigit.etat-de-vaud.ch/outils/git/projects/DGE/repos/obsind/
# Si l'accès n'est pas autorisé, faire une demande à l'Observatoire des indicateurs
library(obsindVD)
# Par défaut : ouvrir l'aide obsindVD (supprimer cette ligne si superflu)
open_fiche_quarto_help()
# Vérifie, ajoute et insère des valeurs par défaut pour les métadonnées manquantes (en-tête YAML)
complete_metadata_params()
# Extraction + validation des métadonnées (en-tête YAML)
selected_metadata <- return_selected_metadata()
# Ajout de l'identifiant dans les en-têtes du document html
display_identifiant(value = selected_metadata[['Identifiant thématique']])
```
::: {.callout-tip .narrow icon="false" collapse="true"}
# Métadonnées de l'indicateur
```{r}
# --------------------------------------
# Présentation des métadonnées ----
# --------------------------------------
tidyr::tibble(
`Attribut` = names(selected_metadata),
`Valeur` = selected_metadata
) |>
gt_table_ind()
```
:::
```{r}
# Préciser la dernière année pour laquelle les données sont complètes
an <- 2025
```
```{r}
# ---------------------------------------------------------
# Tableau de synthèse ----
# ---------------------------------------------------------
# Pour de l'aide sur comment remplir ce tableau de synthèse lancer la commande suivante dans la console :
# obsindVD::open_tableau_synthese_help()
# Pour afficher l'aide spécifique à une fonction, ajouter '?' avant l'appel de la fonction :
# ?icon_up()
tableau_synthese <- list(
# Premier indicateur... attention à la structure !
list(
titre_indicateur = "Subventions octroyées annuellement pour l'établissement d'un audit énergétique CECB®Plus, Vaud <b>[nbre]</b>", # Par défaut = titre issu de la métadonnée (en-tête du document)
valeur_2025 = 2114,
obj_2030 = "...", # valeur numérique OU icônes de flèches
obj_2040 = NA,
obj_2050 = "...",
tendance_observée = icon_down(type = "trend", text = paste0("2019-", an)), # icon_up(), icon_flat(), icon_down()
tendance_évaluée = "..." #icon_meh() # icon_happy(), icon_meh(), icon_sad()
),
# Second indicateur... Répliquer la même structure autant de fois que d'indicateurs à afficher dans le tableau de synthèse
list(
titre_indicateur = "Montants des subventions octroyées annuellement pour l'établissement d'un audit énergétique CECB®Plus, Vaud <b>[Mio CHF]</b>",
valeur_2025 = 2.6,
obj_2030 = "...", # valeur numérique OU icônes de flèches
obj_2040 = NA, # icon_up(type = "obj"), # On peut modifier 'Cible non chiffrée' en modifiant l'argument text = "" par exemple pour ne rien afficher
obj_2050 = "...",
tendance_observée = icon_down(type = "trend", text = paste0("2019-", an)), # text obligatoire pour type = 'trend'
tendance_évaluée = "..." # icon_happy(tooltip = "Exemple d'info-bulle personnalisé") # 'tooltip' modifie l'info-bulle par défaut
)
)
# Impression du tableau de synthèse
print_tableau_synthese(tableau_synthese) # Le résultat peut être customisé comme un objet {gt}
```
# Description {#sec-description}
Cet indicateur informe sur le nombre et les montants des subventions que le Canton de Vaud a versé à travers le [Programme Bâtiments](https://www.vd.ch/environnement/energie/subventions-programme-batiments) afin d’encourager les propriétaires de bâtiments construits avant 2000 à réaliser un Certificat énergétique cantonal des bâtiments CECB®Plus. Il montre l’intérêt toujours plus important des propriétaires à connaître la qualité énergétique de leur bâtiment et à identifier des pistes d’amélioration.
# Cadre de référence {#sec-cadre-reference}
Les objectifs de réduction de la consommation d’énergies sont définis dans la Conception cantonale de l’énergie ([CoCEn 2019](https://www.vd.ch/fileadmin/user_upload/themes/environnement/energie/fichiers_pdf/CoCEn_Pub_complete_20190816.pdf)), dont un des cadres est la loi fédérale sur la réduction des émissions de CO<sub>2</sub> ([RS 641.71](https://www.lexfind.ch/fe/fr/tol/26489/versions/261035/fr)).
# Graphique {#sec-graphique}
```{r, echo=FALSE, message=FALSE, warning=FALSE, results='hide'}
# ---------------------------------------------------------
# Préparation des données à partir des données brutes
# ---------------------------------------------------------
# Reprendre le même code que pour la fiche IND_08.05.03.01_Subventions_Batiments
# S'assurer que utilsDIREN est installée
# remove.packages("utilsDIREN") # (si message erreur <utilsDIREN.rdb is corrupt>)
devtools::install("P:/DIREN/11 POLITIQUE ENERG/11.08 Indicateurs et stat/0_R_packages_DIREN/utilsDIREN")
## format ----
# source("P:\\DIREN\\11 POLITIQUE ENERG\\11.08 Indicateurs et stat\\14 Scripts génériques R\\format_variables.R", encoding = "UTF-8")
utilsDIREN::load_format_variables()
# Vérifier que l'objet est bien importé
if(!exists("mesures_pb")){
message("L'objet 'mesures_pb' n'existe pas, vérifier blablabla")
}
expected_domaines <- c("Mesures indirectes", "Isolation thermique",
"Technique du bâtiment", "Rénovation de systèmes", "Construction neuve",
"Chauffage centralisé")
actual_domaines <- mesures_pb |> distinct(MESURE_DOMAINE) |> pull(MESURE_DOMAINE)
if(length(setdiff(expected_domaines, actual_domaines))>0){
stop("Les domaines de 'mesures_pb' attendus ne correspondent pas à ce qui est observé")
}
# load data ----
# Idéalement voir si on peut utiliser le "find_latest_date_file". Sinon, pas grave on changera à chaque fois manuellement
pb_file <- utilsDIREN::find_latest_date_file(
dir = "P:/DIREN/02 PILOTAGE DIREN/02.11 Bases de donnees/PROGRAMME_BATIMENTS/04_extractions_traitees/",
type = "files",
file_pattern = "^PB_API_2017-01-01",
date_type = "date"
)
pb_read <- read_xlsx(pb_file) |>
janitor::clean_names(case="screaming_snake") |>
# Exclure les mesures concernant la mobilité (VD1) et les VD2
filter(!MESURE %in% c("VD1", "VD2")) |>
# Changer des noms de variables
# Promesses => ANNEE_BUDGET_PROMESSE (car cohérent avec IWF)
# Paiements => ANNEE_DECISION_PAIEMENT (car cohérent avec année où les travaux ont été payés (et non budgetisés))
rename(ANNEE_PROMESSE = ANNEE_BUDGET_PROMESSE, ANNEE_PAIEMENT = ANNEE_DECISION_PAIEMENT )
# prepare data ----
# Créer une colonne DEMANDE où il y a un "1" partout (demandes transmises à la DIREN)
pb_prep <- pb_read |>
# Rajout de "NA" pour tous les montants des demandes de subvention (sinon ça bloque car il n'y a pas de telle variable)
mutate(MONTANT_IMPORT = NA) |>
# Créer une colonne IMPORT où il y a un "1" partout (demandes transmises à la DIREN)
mutate(IMPORT = 1) |>
# Nouvelle variable AE_APRES_TRAD
# Traduction des ae informés dans la base données PB
mutate(AE_APRES_TRAD = case_when(
AE_APRES %in% c("holz") ~ "Bois-Pellets",
AE_APRES %in% c("wpl", "wps", "wpw") ~ "PAC",
AE_APRES %in% c("wn") ~ "CAD",
ID %in% c("VD-25-1713-IP19", "VD-25-2639-IP19", "VD-25-4438-IP19", "VD-25-5356-IP19", "VD-25-4649-IP19") ~"PAC", # Cas de IP19 qui avaient électricité comme AE_APRES. Après vérification par ASL, c'est CAD
TRUE ~ AE_APRES
)) |>
# mutate(AE = case_when(
# AE_allemand %in% c("eledezent", "eledez") ~ "Chauffage électrique décentralisé",
# AE_allemand == "elezent" ~ "Chauffage électrique centralisé",
# AE_allemand == "oel" ~ "Chauffage au mazout",
# AE_allemand == "gas" ~ "Chauffage à gaz",
# AE_allemand %in% c("wp", "sole", "wasser", "umwelt", "wps", "wpl", "wpw") ~ "Pompe à chaleur", # we are more specific after with M05/M06
# AE_allemand == "wn" ~ "Raccordement à un réseau de chaleur",
# AE_allemand %in% c("pellets", "holz", "stueck", "pellet", "schnitzel") ~ "Chauffage au bois",
# AE_allemand %in% c("abwaerme", "sonst", "and") ~ "Autre",
# .default = NA
# Nouvelle variable AE_APRES_NEW
# Pour près de la moitié des subventions M2 à M07, l'agent énergétique après manque. On déduit donc l'agent énergétique d'après la subvention
mutate(AE_APRES_NEW = case_when(
MESURE %in% c("M02", "M03","M04","IP04") ~ "Bois-Pellets",
MESURE %in% c("M05", "M06", "IP05", "IP06") ~ "PAC",
MESURE %in% c("M07", "IP07") ~ "CAD",
TRUE ~ AE_APRES_TRAD
))
## Integrate Domaine de mesures ----
mesures_pb <- mesures_pb |>
select(MESURE, MESURE_TRAD, MESURE_DOMAINE)
pb <- pb_prep |>
left_join(mesures_pb, join_by(MESURE))
### Ordrer les mesures ----
fct_trad_mesure <- c("Isolation thermique","Technique du bâtiment",
"Rénovation de systèmes", "Construction neuve", "Chauffage centralisé", "Mesures indirectes")
pb <- pb |>
mutate(MESURE_DOMAINE = factor(MESURE_DOMAINE, levels = fct_trad_mesure))
### Créer MONTANT_PROMESSE_EGID et MONTANT_PAIEMENT_EGID pour tenir compte du nombre d'EGID concernés par une subvention
### Chaque ligne correspond à un EGID (et non pas subvention)
# pb <- pb |>
# separate_rows(EGID, sep = ";") |>
# mutate(EGID = trimws(EGID)) |>
# group_by(ID) |>
# mutate(nb_EGID = n()) |>
# ungroup() |>
# mutate(MONTANT_PAIEMENT_EGID = MONTANT_PAIEMENT / nb_EGID,
# MONTANT_PROMESSE_EGID = MONTANT_PROMESSE / nb_EGID)
# function ----
prepare_pb_statistics <- function(data, var_type){
## sélection des années concernées ----
data <- data |>
filter(.data[[paste0("ANNEE_", var_type)]]<=an)
###########################################
# mesures_total (Nombre et Montants) ----
###########################################
# Nombre de subventions
mesures_nombre <- data |>
filter(.data[[var_type]]==1) |>
group_by(.data[[paste0("ANNEE_", var_type)]], MESURE_DOMAINE) |>
summarise(NOMBRE = n()) |>
mutate(MESURE_DOMAINE = factor(MESURE_DOMAINE, levels = fct_trad_mesure)) |>
arrange(MESURE_DOMAINE) |>
pivot_wider(names_from = MESURE_DOMAINE, values_from = NOMBRE)|>
mutate(TYPE = "Subventions_Nombre")
# Montants des subventions
mesures_montants <- data |>
filter(.data[[var_type]]==1) |>
group_by(.data[[paste0("ANNEE_", var_type)]], MESURE_DOMAINE) |>
summarise(MONTANT = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE)) |>
mutate(MESURE_DOMAINE = factor(MESURE_DOMAINE, levels = fct_trad_mesure)) |>
arrange(MESURE_DOMAINE) |>
pivot_wider(names_from = MESURE_DOMAINE, values_from = MONTANT)|>
mutate(TYPE = "Subventions_Montants")
# Montants médians des subventions
mesures_median <- data |>
filter(.data[[var_type]]==1) |>
group_by(.data[[paste0("ANNEE_", var_type)]], MESURE_DOMAINE) |>
summarise(MONTANT_MEDIAN = median(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE)) |>
mutate(MESURE_DOMAINE = factor(MESURE_DOMAINE, levels = fct_trad_mesure)) |>
arrange(MESURE_DOMAINE) |>
pivot_wider(names_from = MESURE_DOMAINE, values_from = MONTANT_MEDIAN)|>
mutate(TYPE = "Subventions_Median")
# Montants médians totaux
median_tot <- data |>
filter(.data[[var_type]]==1) |>
group_by(MESURE_DOMAINE) |>
summarise(MONTANT_MEDIAN = median(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE)) |>
mutate(MESURE_DOMAINE = factor(MESURE_DOMAINE, levels = fct_trad_mesure)) |>
arrange(MESURE_DOMAINE) |>
pivot_wider(names_from = MESURE_DOMAINE, values_from = MONTANT_MEDIAN)|>
mutate(TYPE = "Subventions_Median_total")
# Lier N et Montants
mesures_total <- mesures_nombre |> bind_rows(mesures_montants, median_tot, mesures_median)
# output_2 <- data |>
# dplyr::filter(.data[[var_type]]==1) |>
# dplyr::group_by(.data[[paste0("ANNEE_", var_type)]]) |>
# dplyr::summarise(
# n = n(),
# MONTANT = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE)
# ) |>
# mutate(TYPE = paste0(var_type, "_OUTPUT_2"))
# output <- mesures |> bind_rows(output_2)
##################################################
# renov : partielle et globale ----
##################################################
# Rénovations partielles : Mesure M01 (Façade, toit, …) sans Bonus (M14 ou M15)
# Il s'agit donc de prendre les M01 qui ne font pas partie de la liste des EGID ayant reçu un bonus
# Rénovation globale:
# - M01 en combinaison avec M14 ou M15 (ou IP14 depuis 2025)
# - M12 ou M13
# DF par types de mesures
m01 <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE == "M01")
m1213 <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M12", "M13"))
m1415 <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c( "M14", "M15","IP14"))
# Listes par types de mesures
liste_m01 <- m01 |>
pull(EGID)
liste_m1415 <- m1415 |>
pull(EGID)
# M01 sans bonus M14 ou M15
m01_sans_m1415 <- m01 |>
filter(!EGID %in% liste_m1415)
# M1415 AVEC M01
m1415_avec_m01 <- m1415 |>
filter(EGID %in% liste_m01)
# M01 avec bonus M14 ou M15
m01_avec_m1415 <- m01 |>
filter(EGID %in% liste_m1415)
# renov_partielle
renov_partielle <- m01_sans_m1415 |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "RENOV_PARTIELLE")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
renov_partielle_total <- m01_sans_m1415 |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "RENOV_PARTIELLE_TOTAL")
# renov_globale
# Rénovations globales: Mesures M12 (minergie), M13 (CECB), M01+M14 (Bonus rénovation complète), M01+M15 (Bonus Minergie)
# lier les deux files qui contiennent les rénovation globales (m01_avec_m1415 et m1415_avec_m01)
renov_glob_temp <- m01_avec_m1415 |>
bind_rows (m1415_avec_m01)
renov_glob_temp <- renov_glob_temp |>
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = T)) |>
ungroup()
renov_globale <- renov_glob_temp |>
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(NOMBRE = n(),
MONTANT = sum(MONTANT_EGID, na.rm = T),
MONTANT_MEDIAN = median(MONTANT_EGID, na.rm = T)) |>
mutate(TYPE = "RENOV_GLOBALE")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
renov_globale_total <- renov_glob_temp |>
summarise(!!col_annee := 9999 ,
NOMBRE = n(),
MONTANT = sum(MONTANT_EGID, na.rm = T),
MONTANT_MEDIAN = median(MONTANT_EGID, na.rm = T)) |>
mutate(TYPE = "RENOV_GLOBALE_TOTAL")
# renov totale (partielle ou globale)
renov_tot_temp <- m01_sans_m1415 |> # renov_partielle
bind_rows (m01_avec_m1415, m1415_avec_m01) # renov_globale
renov_tot <- renov_tot_temp |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "RENOV_TOT")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
renov_tot_total <- renov_tot_temp |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "RENOV_TOT_TOTAL")
# Lier toutes les tables renov
renov <- renov_tot_total |> bind_rows(renov_tot, renov_partielle_total, renov_partielle, renov_globale_total, renov_globale)
# renov <- renov_partielle_total |> bind_rows( renov_partielle, renov_globale_total, renov_globale)
#########################################
# rempl_syst : Remplacements de chaudières ----
# Remplacement GAZ, MAZOUT et ELECTRICITE
##########################################
# Total (Gaz, Mazout ou Electricité)
######
rempl_tot <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT %in% c("gas", "oel", "elezent", "eledezent", "eledez" ) ) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_TOT")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
rempl_tot_total <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT %in% c("gas", "oel", "elezent", "eledezent", "eledez" )) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_TOT_TOTAL")
# GAZ
######
rempl_gaz <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT == "gas" ) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_GAZ")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
rempl_gaz_total <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT == "gas" ) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_GAZ_TOTAL")
# MAZOUT
########
rempl_mazout <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT == "oel" ) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_MAZOUT")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
rempl_mazout_total <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT == "oel" ) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_MAZOUT_TOTAL")
# ELECTRICITE
#############
rempl_elec <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT %in% c("elezent", "eledezent", "eledez" )) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_ELEC")
# group_by(.data[[paste0("ANNEE_", var_type)]]) |>
# summarise(NOMBRE = n(),
# MONTANT = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = T),
# MONTANT_MEDIAN = median(.data[[paste0("MONTANT_", var_type)]], na.rm = T)) |>
# mutate(TYPE = "REMPLACEMENT_ELEC")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
rempl_elec_total <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT %in% c("elezent", "eledezent", "eledez" )) |>
# 1) Agrégation au niveau bâtiment
group_by(EGID, .data[[paste0("ANNEE_", var_type)]]) |>
summarise(
MONTANT_EGID = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = TRUE),
.groups = "drop") |>
# 2) Statistiques annuelles
summarise(!!col_annee := 9999 ,
NOMBRE = n(), # nombre de bâtiments (EGID)
MONTANT = sum(MONTANT_EGID), # montant total
MONTANT_MEDIAN = median(MONTANT_EGID),
.groups = "drop") |>
mutate(TYPE = "REMPLACEMENT_ELEC_TOTAL")
# Lier GAZ, MAZOUT et ELECTRIC
rempl_syst <- rempl_tot_total |> bind_rows(rempl_tot, rempl_gaz_total, rempl_gaz, rempl_mazout_total, rempl_mazout, rempl_elec_total, rempl_elec)
#######################################################################################################
# ae_apres_chgt ----
# Agent énergétique qui remplace GAZ, MAZOUT et ELECTRICITE
# Mesures M02-04 IP04 (Bois), M05-06 IP05-06 (PAC) et M07 IP07 (CAD)
# IP19 retirés car certains pourraient ne pas concerner un chgt de chauffage
#######################################################################################################
# GAZ
ae_apres_gaz <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19"), AE_AVANT == "gas") |>
distinct(EGID,.data[[paste0("ANNEE_", var_type)]], .keep_all = TRUE) |> # ne garder qu'une ligne par bâtiment pour éviter les IP19 qui sont en lien avec une mesure M02-07
group_by(AE_APRES_NEW) |>
summarise(NOMBRE = n()) |>
mutate(perc = round(100*NOMBRE/sum(NOMBRE),1) ) |>
mutate(TYPE = "AE_APRES_GAZ")
# MAZOUT
ae_apres_mazout <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19" ), AE_AVANT == "oel") |>
distinct(EGID, .data[[paste0("ANNEE_", var_type)]], .keep_all = TRUE) |> # ne garder qu'une ligne par bâtiment pour éviter les IP19 qui sont en lien avec une mesure M02-07
group_by(AE_APRES_NEW) |>
summarise(NOMBRE = n()) |>
mutate(perc = round(100*NOMBRE/sum(NOMBRE),1) ) |>
mutate(TYPE = "AE_APRES_MAZOUT")
# MAZOUT
ae_apres_elec <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("M02", "M03", "M04", "M05", "M06", "M07", "IP04", "IP05", "IP06", "IP07", "IP19"), AE_AVANT %in% c("elezent", "eledezent", "eledez" )) |>
distinct(EGID, .data[[paste0("ANNEE_", var_type)]], .keep_all = TRUE) |> # ne garder qu'une ligne par bâtiment pour éviter les IP19 qui sont en lien avec une mesure M02-07
group_by(AE_APRES_NEW) |>
summarise(NOMBRE = n()) |>
mutate(perc = round(100*NOMBRE/sum(NOMBRE),1) ) |>
mutate(TYPE = "AE_APRES_ELEC")
# Lier GAZ, MAZOUT et ELECTRIC
ae_apres_chgt <- ae_apres_gaz |> bind_rows(ae_apres_mazout, ae_apres_elec)
#######################################################################################################
# cecb_plus : Audits énergétiques ----
#######################################################################################################
# Subventions pour des CECB+ (Code = IM07)
cecb_plus_temp <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("IM07")) |>
group_by(.data[[paste0("ANNEE_", var_type)]]) |>
summarise(NOMBRE = n(),
MONTANT = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = T),
MONTANT_MEDIAN = median(.data[[paste0("MONTANT_", var_type)]], na.rm = T)) |>
mutate(TYPE = "CECB_PLUS")
# Faire de même pour l'ensemble des années
col_annee <- paste0("ANNEE_", var_type)
cecb_plus_total <- data |>
filter(.data[[var_type]]==1) |>
filter(MESURE %in% c("IM07")) |>
summarise(!!col_annee := 9999 ,
NOMBRE = n(),
MONTANT = sum(.data[[paste0("MONTANT_", var_type)]], na.rm = T),
MONTANT_MEDIAN = median(.data[[paste0("MONTANT_", var_type)]], na.rm = T)) |>
mutate(TYPE = "CECB_PLUS_TOTAL")
# Lier les deux
cecb_plus <- cecb_plus_total |> bind_rows(cecb_plus_temp)
#######################################################################################################
# Préparation pour file Excel ----
list_objets <- list("mesures_total" = mesures_total,
"renov" = renov,
"rempl_syst" = rempl_syst,
"ae_apres_chgt" = ae_apres_chgt,
"cecb_plus" = cecb_plus
)
writexl::write_xlsx(list_objets, glue("./data/Subventions_{var_type}.xlsx"))
list_objets
}
file_type <- c("PAIEMENT", "PROMESSE", "IMPORT")
purrr::walk(.x = file_type, .f = \(type) prepare_pb_statistics(data = pb, var_type = type))
stats_pb <- purrr::map(
setNames(file_type, file_type),
\(type) prepare_pb_statistics(data = pb, var_type = type)
)
# names(stats_pb) <- file_type
#
#
# datatable(stats_pb$PAIEMENT$mesures_total)
```
```{r }
#| label: fig-G1
##| fig-cap: "Subventions octroyées pour l'établissement d'un audit énergétique CECB®Plus, Vaud"
#| fig.width: 8
#| fig.asp: 0.6
#_______________________________________________________
# G1 - Subventions octroyées pour l'établissement d'un audit énergétique CECB®Plus
#_______________________________________________________
promesses_total <- stats_pb$PROMESSE$cecb_plus |>
filter(TYPE == "CECB_PLUS") |>
# mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
# mutate(VAR = "PROMESSE") |>
mutate(ANNEE = factor(ANNEE_PROMESSE)) |>
arrange(ANNEE) |>
mutate(NOMBRE_CUMULE = cumsum(NOMBRE)) |>
select(ANNEE, NOMBRE, NOMBRE_CUMULE)
# valeur du dernier NOMBRE_CUMULE (pour que ça apparaisse dans le graphique)
last_cumul <- promesses_total |>
filter(ANNEE == an)
##########################################################
# Coefficient
coef <- min(promesses_total$NOMBRE, na.rm = TRUE) /
(0.14*max(promesses_total$NOMBRE_CUMULE, na.rm = TRUE))
g1_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = promesses_total,
aes(x = ANNEE, y = NOMBRE, fill = "CECB_PLUS",
tooltip = paste("Subventions pour certificat énergétique CECB plus ", ANNEE, " : ", label_number(accuracy = 1, big.mark = "'")(NOMBRE)),
data_id = paste(ANNEE, "annuel")),
width = 0.7,
# position = "stack",
color = NA
) +
# Ajout du total sur les stack
geom_text(
data = promesses_total,
inherit.aes = FALSE,
aes(
x = ANNEE,
y = NOMBRE,
label = label_number(accuracy = 1, big.mark = "'")(NOMBRE)
),
vjust = -0.5,
size = 3
) +
# Ajout du total cumulé pour la dernière année
geom_text(
data = last_cumul,
aes(
x = ANNEE,
y = NOMBRE_CUMULE * coef,
label = scales::label_number(big.mark = "'")(NOMBRE_CUMULE)
),
hjust = 0.1, # décale à gauche
vjust = 2, # décalé vers le haut
size = 3.5,
color = "red"
#,
# fontface = "bold"
)+
# lignes pour TOTAL_CUMULE
geom_line_interactive(
data = promesses_total,
aes(
x = ANNEE,
y = NOMBRE_CUMULE * coef,
color = "Cumul",
group = 1
),
linewidth = 1.1
) +
geom_point_interactive(
data = promesses_total,
aes(
x = ANNEE,
y = NOMBRE_CUMULE * coef,
color = "Cumul",
tooltip = paste(
"Total cumulé du nombre de subventions pour l'obtention d'un certificat énergétique CECB plus ",
ANNEE, " : ",
scales::label_number(big.mark = "'")(NOMBRE_CUMULE)
)
,
data_id = paste(ANNEE, NOMBRE_CUMULE, "cumul_pt")
),
size = 2
)+
# Colors
scale_fill_manual(
values = c(
"CECB_PLUS" = "#1b9e77"),
labels = c(
"CECB_PLUS" = "Subventions promises\nannuellement")
) +
scale_color_manual(
values = c("Cumul" = "red"),
labels = c("Cumul" = "Nombre cumulé\nde subventions")
)+
# Titles and caption
scale_y_continuous(
name = "Nombre de subventions annuelles",
sec.axis = sec_axis(~ . / coef, name = "Nombre cumulé de subventions")
) +
# scale_x_continuous(
# breaks = sort(unique(promesses$ANNEE)),
# labels = sort(unique(promesses$ANNEE)),
# expand = expansion(mult = c(0.01, 0.05))
#
# )+
scale_x_discrete()+
# scale_x_continuous(breaks = sort(unique(promesses$ANNEE)))+
labs(
title = str_wrap("**Subventions promises pour l'établissement d'un audit énergétique CECB Plus, Vaud**", width = 65) |>
stringr::str_replace_all("\n", "<br>") ,
x = NULL,
y= "Subventions annuelles en nombre [nbre]",
fill = NULL,
color = NULL,
caption = "Source: IWF / DGE-DIREN<br>Etat au 31.12.2025"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_markdown(face = "bold", size = 12),
plot.subtitle = element_markdown(size = 10),
plot.caption = element_markdown(hjust = 0, size = 9, margin = margin(t = 5), face = "italic"), # rajout italic
plot.caption.position = "plot",
plot.margin = margin(10, 10, 30, 10),
legend.position = "bottom", # "top" "left" "right" "none"
legend.box = "horizontal", #"horizontal"
legend.box.just = "left", # aligne les blocs à gauche
legend.justification = "left",
legend.text = element_markdown(size = 10),
legend.title = element_markdown(size = 12),
legend.spacing.y = unit(0.1, "cm"), # espace entre blocs
legend.margin = margin(t = 0, b = 0), # supprime marge globale
legend.box.spacing = unit(0.1, "cm"), # espace bloc-légende vs reste du plot
axis.text = element_text(size = 8),
axis.title = element_markdown(size = 10)
)
obsindVD::girafe_light(g1_plot,
# Ajout de la transparence aux éléments non-survolés !
options = list(
opts_hover_inv(css = "opacity:0.5;"),
opts_hover(css = "opacity:1;"),
# Ajout du nom du PNG téléchargé + remplacement de 'download' par 'télécharger' (survol icône)
opts_toolbar(
position = "topright",
hidden = c("zoom", "selection"),
pngname = paste0(selected_metadata[['Identifiant thématique']], "_G1"),
tooltips = list(
saveaspng = "Télécharger"
)
)
)
)
ggsave(glue("./images/g1_Nombre_Subventions-CECB_Plus_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
```{r}
#| label: fig-G2
##| fig-cap: "Montants des subventions octroyées pour l'établissement d'un audit énergétique CECB Plus, Vaud"
#| fig.width: 8
#| fig.asp: 0.6
#_______________________________________________________
# G2 - Montants des subventions octroyées pour l'établissement d'un audit énergétique CECB Plus, Vaud
#_______________________________________________________
promesses_montants_total <- stats_pb$PROMESSE$cecb_plus |>
filter(TYPE == "CECB_PLUS") |>
# mutate(TOTAL = rowSums(across(where(is.numeric)), na.rm = TRUE)) |>
# mutate(VAR = "PROMESSE") |>
mutate(MONTANT = MONTANT/1e6,
ANNEE = factor(ANNEE_PROMESSE)) |>
arrange(ANNEE) |>
mutate(MONTANT_CUMULE = cumsum(MONTANT)) |>
select(ANNEE, MONTANT, MONTANT_CUMULE)
# valeur du dernier MONTANT_CUMULE (pour que ça apparaisse dans le graphique)
last_cumul_montants <- promesses_montants_total |>
filter(ANNEE == an)
promesses_montants <- stats_pb$PROMESSE$cecb_plus |>
filter(ANNEE_PROMESSE != 9999 ) |>
mutate(
MONTANT = MONTANT/1e6,
ANNEE = factor(ANNEE_PROMESSE)
) |>
select(ANNEE, MONTANT, TYPE) |>
arrange(ANNEE)
# Coefficient
coef <- min(promesses_montants$MONTANT, na.rm = TRUE) /
(0.5*max(promesses_montants$MONTANT, na.rm = TRUE))
g2_plot <- ggplot() +
# Bars (objectives and consumption)
geom_col_interactive(
data = promesses_montants,
aes(x = ANNEE, y = MONTANT, fill="CECB_PLUS",
tooltip = paste("Montants octroyés pour l'établissement d'audits énergétiques CECB Plus en ", ANNEE, " : ", label_number(accuracy = 0.1, big.mark = "'")(MONTANT), " Mio CHF"),
data_id = paste(ANNEE, TYPE, "annuel")),
# fill = "#1b9e77",
width = 0.7
# ,
# position = "dodge",
# color = NA
) +
# Ajout du total cumulé pour la dernière année
geom_text(
data = last_cumul_montants,
aes(
x = ANNEE,
y = MONTANT_CUMULE * coef,
label = label_number(accuracy = 0.1)(MONTANT_CUMULE)
),
hjust = 0.2, # décale à gauche
vjust = 2, # décalé vers le bas
size = 3.5,
color = "red",
# fontface = "bold"
)+
# lignes pour TOTAL_CUMULE
geom_line_interactive(
data = promesses_montants_total,
aes(
x = ANNEE,
y = MONTANT_CUMULE * coef,
color = "Cumul",
group = 1
),
linewidth = 1.1
) +
geom_point_interactive(
data = promesses_montants_total,
aes(
x = ANNEE,
y = MONTANT_CUMULE * coef,
color = "Cumul",
tooltip = paste(
"Total cumulé des montants octroyés en ",
ANNEE, " : ",
scales::label_number(accuracy = 0.1)(MONTANT_CUMULE), " Mio CHF"
)
,
data_id = paste(ANNEE, MONTANT_CUMULE, "cumul_pt")
),
size = 2
)+
# Colors
scale_fill_manual(
values = c(
"CECB_PLUS" = "#1b9e77"),
labels = c(
"CECB_PLUS" = "Montants promis\nannuellement"),
name = NULL
) +
scale_color_manual(
values = c("Cumul" = "red"),
labels = c("Cumul" = "Montants cumulé\nde subventions")
)+
# Titles and caption
scale_y_continuous(
name = "Montants annuels [Mio CHF]",
sec.axis = sec_axis(~ . / coef, name = "Montants cumulés [Mio CHF] ")
) +
scale_x_discrete()+
guides(
fill = guide_legend(order = 1),
color = guide_legend(order = 2)
)+
labs(
title = str_wrap("**Montants octroyés pour l'établissement des audits énergétiques CECB Plus, Vaud**", width = 65) |>
stringr::str_replace_all("\n", "<br>") ,
x = NULL,
y= "Montants des subventions [Mio CHF]",
fill = NULL,
color = NULL,
caption = "Source: IWF / DGE-DIREN<br>Etat au 31.12.2025"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_markdown(face = "bold", size = 12),
plot.subtitle = element_markdown(size = 10),
plot.caption = element_markdown(hjust = 0, size = 9, margin = margin(t = 5), face = "italic"), # rajout italic
plot.caption.position = "plot",
plot.margin = margin(10, 10, 30, 10),
legend.position = "bottom", # "top" "left" "right" "none"
legend.box = "horizontal", #"horizontal"
legend.box.just = "left", # aligne les blocs à gauche
legend.justification = "left",
legend.text = element_markdown(size = 10),
legend.title = element_markdown(size = 12),
legend.spacing.y = unit(0.1, "cm"), # espace entre blocs
legend.margin = margin(t = 0, b = 0), # supprime marge globale
legend.box.spacing = unit(0.1, "cm"), # espace bloc-légende vs reste du plot
axis.text = element_text(size = 8),
axis.title = element_markdown(size = 10)
)
obsindVD::girafe_light(g2_plot,
# Ajout de la transparence aux éléments non-survolés !
options = list(
opts_hover_inv(css = "opacity:0.5;"),
opts_hover(css = "opacity:1;"),
# Ajout du nom du PNG téléchargé + remplacement de 'download' par 'télécharger' (survol icône)
opts_toolbar(
position = "topright",
hidden = c("zoom", "selection"),
pngname = paste0(selected_metadata[['Identifiant thématique']], "_G2"),
tooltips = list(
saveaspng = "Télécharger"
)
)
)
)
ggsave(glue("./images/g2_Montants_Subventions_CECB_Plus_2017-{an}.png"), width = 8, height = 6, dpi = 300)
```
# Analyse {#sec-analyse}
<!-- Aide au remplissage : consulter la section correspondante avec `obsindVD::open_aide_remplissage_help()` -->
## Description statistique {#sec-analyse-description}
Le nombre de subventions octroyées pour l'établissement d'un audit énergétique CECB®Plus était en constante augmentation entre 2018 (586) et 2023 (1’910). Après une baisse en 2024 (1'594), un nouveau record a été atteint en 2025 avec 2114 promesses d’octroi (@fig-G1). Au total, 10'750 de ces subventions ont été octroyées depuis 2018, pour un montant cumulé de 13 millions de francs (@fig-G2).
## Interprétation {#sec-analyse-interpretation}
La hausse du nombre de subventions pour l’établissement d’un CECB®Plus s’inscrit dans la tendance générale observée pour les autres aides liées au Programme Bâtiment.
## Périmètre et limites {#sec-analyse-perimetre}
Depuis 2017, le CECB est obligatoire lors d’un remplacement d’un chauffage fossile par une nouvelle installation de chauffage fossile. Mettre en place un CECB®Plus est par ailleurs obligatoire si le CECB obtient la note F ou G sur l’enveloppe.
Lors de la demande de subvention M01 (isolation thermique) du Programme Bâtiments, si les montants d’encouragement dépassent CHF 10'000, un CECB®Plus est obligatoire pour l’octroi de cette subvention.
Le CECB®Plus, comme document de référence, est requis pour plusieurs autres mesures de subventions du Programme Bâtiments telle qu’une rénovation globale avec certificat CECB (M13), le bonus pour une rénovation globale (M14, variante 3) et l’accompagnement des maîtres d’ouvrage (subvention AMO mise en place en avril 2022).
De nombreuses communes ont mis en place un fond sur l’énergie lors de cette période 2017-2025 pour proposer des mesures de subventions comme l’audit énergétique (CECB®Plus).
# Tableaux {#sec-tableaux}
```{r}
#| label: tbl-T1
##| tbl-cap: "Nombre de subventions octroyées annuellement pour l'établissement d'un audit énergétique CECB Plus, Vaud"
promesses_wide <- stats_pb$PROMESSE$cecb_plus |>
# filter(TYPE == "Subventions_Nombre") |>
mutate(MONTANT = MONTANT/1e6) |>
mutate(Année = as.character(ANNEE_PROMESSE)) |>
mutate(Année = case_when(
Année == "9999" ~ "Total",
TRUE ~ Année
)) |>
select(Année, NOMBRE, MONTANT, MONTANT_MEDIAN)
# promesses_wide <- promesses_long |>
# pivot_wider(names_from = TYPE, values_from = NOMBRE)
t1 <- promesses_wide|>
gt() |>
tab_header(title = md("**Subventions octroyées pour l'établissement d'un audit énergétique CECB Plus, Vaud**"))|>
cols_width(everything() ~ pct(100 / ncol(promesses_wide))) |>
tab_style(style = cell_text(weight = "bold"),
locations = list(cells_body(rows = Année == "Total"),
cells_column_labels(),
cells_body(columns = "NOMBRE"))) |>
tab_style(
style = cell_text(align = "center"),
locations = cells_column_labels()
) |>
tab_style(
style = cell_text(align = "left"),
locations = cells_footnotes()
) |>
tab_style(
style = cell_text(align = "left"),
locations = cells_source_notes()
) |>
cols_align(align = "center") |> #, columns = "Année") |>
cols_label(
Année = "Année",
NOMBRE = "Nombre",
MONTANT = "Montants",
MONTANT_MEDIAN = "Montants médians"
) |>
cols_label_with(
columns = NOMBRE,
fn = \(col) md(paste0(col, "\n\n[nbre]"))
) |>
cols_label_with(
columns = MONTANT,
fn = \(col) md(paste0(col, "\n\n[Mio CHF]"))
) |>
cols_label_with(
columns = MONTANT_MEDIAN,
fn = \(col) md(paste0(col, "\n\n[CHF]"))
) |>
fmt_number(columns = c(NOMBRE, MONTANT_MEDIAN),
sep_mark = "'",
decimals = 0
) |>
fmt_number(columns = MONTANT,
sep_mark = "'",
decimals = 1
) |>
tab_footnote(footnote = "Certificat Energétique Cantonal des Bâtiments complété par un rapport de conseil. Lors d’un CECB®Plus, trois variantes personnalisées sont proposées en vue d’une rénovation énergétique.",
locations = cells_title(groups = "title"),
placement = "right") |>
tab_style(style = cell_borders(sides = "all"),
locations = list(cells_column_labels(), cells_column_spanners())) |>
tab_style(style = cell_borders(sides = c("left", "right")),
locations = list(cells_body())) |>
tab_options(column_labels.border.bottom.color = "black") |>
# fmt_missing(columns = everything(), missing_text = "") |>
opt_table_outline(style = "solid", width = px(2), color = "lightgrey") |>
tab_source_note(
source_note = md("*Source: IWF / DGE-DIREN<br>Etat au 31.12.2025*")
)
t1
gtsave(t1, glue("./images/t1_Promesses_Subventions_CECB_Plus_2017-{an}.html"))
```
# Méthode {#sec-methode}
Les données proviennent de IWF, prestataire informatique chargé de la plateforme de gestion des demandes de subvention du Programme Bâtiments, qui met à disposition des cantons les données concernant les subventions qu’ils octroient dans le cadre du Programme Bâtiments, qu’il s’agisse des demandes de subventions, des subventions pour lesquelles une décision d’octroi a été prise (subventions promises) ou des subventions payées.
La mesure concernée par ces subventions est la mesure IM-07 (Etablissement d'un CECB®Plus).
Subventions promises : nombre de demandes de subventions pour lesquelles le Canton a donné son accord de principe. L’année correspond à celle du budget auquel il est rattaché.
Montant des subventions promises : montant cumulé des subventions acceptées pour le budget d’une certaine année.
# Comparaison {#sec-comparaison}
Les comparaisons intercantonales doivent être effectuées avec prudence. La plupart des écarts sont souvent induits par des fluctuations de la demande et sont peu influençables par la politique cantonale.
# Références {#sec-ref}
<!-- Aide au remplissage : consulter la section correspondante avec `obsindVD::open_aide_remplissage_help()` -->
## Fiches associées {#sec-ref-fiches}
**Fiches Indicateur** :
* [IND_08.05.03.01 : Subventions dans le cadre du Programme Bâtiments, Vaud](https://stat-climat-vd.ch/fiches-indicateurs/themes/energie/IND_08.05.03.01_Subventions_Batiments.html)
* [IND_08.05.03.02 : Subventions pour rénovation partielle ou globale du bâtiment, Vaud](https://stat-climat-vd.ch/fiches-indicateurs/themes/energie/IND_08.05.03.02_Subventions_Renovation_Batiment.html)
* [IND_08.05.03.04 : Subventions pour remplacement d'un chauffage à combustible fossile ou électrique, Vaud](https://stat-climat-vd.ch/fiches-indicateurs/themes/energie/IND_08.05.03.04_Subventions_Remplacement_Chaudiere.html)
## Autres références {#sec-ref-autres}
* [DGE-DIREN - Conception cantonale de l’énergie (CoCEn 2019)](https://www.vd.ch/fileadmin/user_upload/themes/environnement/energie/fichiers_pdf/CoCEn_Pub_complete_20190816.pdf)
* [DGE-DIREN - Programme Bâtiments Vaud](https://www.vd.ch/themes/environnement/energie/subventions-programme-batiments)
* [Loi fédérale sur la réduction des émissions de CO<sub>2</sub> (Loi sur le CO<sub>2</sub>, 641.71)](https://www.fedlex.admin.ch/eli/cc/2000/148/fr)
* [OFEN - Le Programme Bâtiments - Rapports annuels](https://www.leprogrammebatiments.ch/fr/meta/publications-et-photos/rapports-et-statistiques/)
# Glossaire {#sec-glossaire}
```{r}
# ---------------------------------------------------------
# Bloc pour lecture du file BRUT où se trouvent toutes les définition pour le glossaire et création du data.frame "definition" ----
# ---------------------------------------------------------
tryCatch(
expr = {readxl::read_excel("P:/DIREN/11 POLITIQUE ENERG/11.08 Indicateurs et stat/1 Indicateurs DIREN/3-Fiches IND MET OBJ/Liste Definitions.xlsx",
skip = 2) |>
janitor::clean_names(case="screaming_snake") |>
select(TERME, DEFINITION) |>
readr::write_csv2("./data/definitions.csv")
},
error = function(e) message("Attention: la table définition n'a pas pu être réactualisée avec les données brutes du P:/ ", e$message),
warning = function(w) message("Attention: la table définition n'a pas pu être réactualisée avec les données brutes du P:/ ", w$message)
)
```
```{r}
# ---------------------------------------------------------
# Bloc pour sélectionner les définitions à apparaître dans le glossaire ----
# ---------------------------------------------------------
# Lecture du file
def_tot <- readr::read_delim(file = "./data/definitions.csv",
delim = ";",
show_col_types = FALSE) |>
# Mettre les premières lettres de chaque définition en majuscule
dplyr::mutate(DEFINITION = stringr::str_replace(DEFINITION,"^\\p{L}",stringr::str_to_upper))
# Sélection des définitions
definitions <- def_tot |>
filter(TERME %in% c(
"Subventions octroyées",
"Montant médian",
"CECB",
"CECB+"
))
# Print de la table avec modification des columns
definitions |>
gt_table_ind() |>
gt::cols_label(TERME = "", DEFINITION ="Définition") |>
gt::tab_options(table.align = "left")
```
# Annexes {#sec-annexes .unnumbered .hidden}
<!-- Aide au remplissage : consulter la section correspondante avec `obsindVD::open_aide_remplissage_help()` -->