Discussion :

[pepsister]

Bonjour,

Voilà j'ai un tableau où je rentre des groupes d'inscrits, dans certaines cellules j'ai des listes déroulantes, dans d'autres j'ai des calculs comme le calcul de l'âge en fonction de la date de naissance, j'ai aussi des mises en forme définit dans une macro par groupe.
Je souhaiterais ajouter un bouton effacer pour à chaque fois que j'en ai besoin remettre mon fichier à zéro. C'est à dire supprimer les groupes, leurs données mais aussi la mise en forme (couleur, bordure etc...). Par contre je souhaite garder mes listes déroulantes et surtout mes formules dans mes cases.
J'ai essayé plusieurs fonctions mais ca supprime toutes les valeurs de mes cases et également les formules. Je ne vois pas comment faire. Si quelqu'un peut me donner un coup de pouce ce serait très sympa car là je bloque.
Le fichier est assez gros, du coup je l'ai zippé en .rar
Il est accessible via le lien:
http://dl.free.fr/getfile.pl?file=/ig4iAG5i

[PMO2017]

Bonjour,

Une piste à tester sur une copie de votre classeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub Effacer_pmo()
Dim S As Worksheet
Dim R As Range
Dim R_Formules As Range
Dim R2 As Range
Dim C As Range
Dim LastLig&
Dim LastCol&
 
Set S = ActiveSheet
LastLig = S.Cells(Rows.Count, 1).End(xlUp).Row            'Valeur à ajuster
LastCol = S.Cells(1, Columns.Count).End(xlToLeft).Column
'--- Désactive l'évènementiel ---
Application.EnableEvents = False
'--- Toute la plage sauf les lignes de titres 1 et 2 ---
Set R = S.Range(S.Cells(3, 1), S.Cells(LastLig, LastCol))
R.UnMerge         'supprime les fusions
R.ClearFormats    'supprime les formats
'--- Le Range des Formules ---
Set R_Formules = R.SpecialCells(xlCellTypeFormulas, 23)
'--- Pour touver la plage des cellules qui ne sont pas des formules ---
For Each C In R
  If Application.Intersect(C, R_Formules) Is Nothing Then
    If R2 Is Nothing Then
      Set R2 = C
    Else
      Set R2 = Application.Union(R2, C)
    End If
  End If
Next C
'---
R2.ClearContents  'supprime les valeurs
'--- Active l'évènementiel ---
Application.EnableEvents = True
End Sub