Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub Audit()
Dim Sh As Worksheet, LigneInsertion As Integer, DerLig As Integer, N As Integer
' Figer écran
Application.ScreenUpdating = False
' N est le nombre de non conformités trouvées
N = 0
' Recherche où se trouve "ÉTABLISSEMENT DE CETTE DÉCLARATION D’ACCESSIBILITÉ" dans la page Declaration.
LigneInsertion = 1 + Application.Match("ÉTABLISSEMENT DE CETTE DÉCLARATION D’ACCESSIBILITÉ*", Sheets("Declaration").Range("A:A"), 0)
' Insertion de la date d'audit
Sheets("Declaration").Range("A" & LigneInsertion) = "Cette déclaration a été établie le " & Format(Date, "dddd dd mmmm yyyy")
' Recherche où se trouve "Non-conformité" dans la page Declaration. C'est la ligne où inserer.
LigneInsertion = 1 + Application.Match("Non-conformité", Sheets("Declaration").Range("A:A"), 0)
' On ajoute les critères NC de la feuille Critères dans la feuille déclaration
DerLig = Sheets("Critères").Range("D65000").End(xlUp).Row
For Ligne = 2 To DerLig
If Sheets("Critères").Cells(Ligne, "D") = "NC" Then
With Sheets("Declaration")
.Rows(LigneInsertion).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' Insertion ligne
.Cells(LigneInsertion, 1) = Sheets("Critères").Cells(Ligne, 2) ' N°
.Cells(LigneInsertion, 2) = Sheets("Critères").Cells(Ligne, 3) ' Critère
LigneInsertion = LigneInsertion + 1 ' Incrément index pour la prochaine insertion
End With
End If
Next Ligne
' Recherche où se trouve "Contenus non soumis à l’obligation d’accessibilité" dans la page Declaration. C'est la ligne où inserer.
LigneInsertion = 1 + Application.Match("Contenus non soumis à l’obligation d’accessibilité", Sheets("Declaration").Range("A:A"), 0)
' On parcourt toutes les feuilles
For Each Sh In ActiveWorkbook.Sheets
If Len(Sh.Name) = 3 And Left(Sh.Name, 1) = "P" Then ' Ne concerne que les feuilles commençant par P et ayant 3 caractères ( type P01 )
DerLig = Sheets(Sh.Name).Range("D65000").End(xlUp).Row ' Nombre de lignes de la feuille Pxx
For Ligne = 4 To DerLig ' Pour toutes les lignes de la feuille Pxx
If Sheets(Sh.Name).Cells(Ligne, "E") = "D" Then ' Si D alors
With Sheets("Declaration") ' Inserer lignes et ajouter données
.Rows(LigneInsertion).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' Insertion ligne
.Cells(LigneInsertion, 1) = Sheets(Sh.Name).Cells(Ligne, 8) ' Texte de la colonne H de toutes les lignes qui contiennent la valeur D en colonne E
LigneInsertion = LigneInsertion + 1 ' Incrément index pour la prochaine insertion
N = N + 1 ' Une non conformité de plus
End With
End If
Next Ligne
End If
Next Sh
' Sortie avec message
Application.ScreenUpdating = True
MsgBox " Nombre de non conformité trouvées : " & N
End Sub