Discussion :

[iixii]

Bonjour à tous

J'ai trouvé sur le net un code qui fait exactement ce que j'ai besoin "supprimer les formats des cellules vides ou non utilisés".
Le code date un peu et ne fonctionne pas sur excel 2010.

Si une ame pourrait m'aider. Merci pour votre aide.

Merci aussi à son auteur;
http://dj.joss.free.fr/format.htm


Ci dessous le code:

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Sub SupprFormatsInutilisés()
SupprFormats True
End Sub
 
Sub 
SupprFormatsCellulesVides()
SupprFormats False
End Sub
 
Private Sub 
SupprFormats(Min As Boolean)
 
Dim Form As String, Prev As String, F As 
String
Dim i As Integer, j As Integer
 
Dim dObj As New DataObject, c As 
New Collection Dim Wksht As Worksheet, Cell As Range, Shts As 
Sheets
 
Application.EnableCancelKey = xlDisabled
Application.StatusBar 
= "Collecte des formats en cours..."
Do
j = (j + 1) Mod 5
If j = 0 Then 
i = i + 1
Application.SendKeys "{TAB}{END}{TAB 2}{HOME}" & IIf(i, "{PGDN 
" _
& i & "}", "") & IIf(j, "{DOWN " & j & "}", "") & 
"+{TAB}^c{ESC}"
Application.Dialogs(xlDialogFormatNumber).Show
dObj.GetFromClipboard
Form 
= dObj.GetText(1)
If Form = Prev Then Exit Do
c.Add Form, Form
Prev = 
Form
Loop
 
Application.StatusBar = "Recherche des formats utilisés en 
cours..."
Set Shts = ActiveWindow.SelectedSheets
On Error Resume 
Next
For Each Wksht In Worksheets
Wksht.Select
For Each Cell In 
Wksht.UsedRange
If Not IsEmpty(Cell) Or Min Then
F = 
c.Item(Cell.NumberFormatLocal)
If F <> "" Then
c.Remove 
Cell.NumberFormatLocal
F = ""
End If
End If
Next Cell
Next Wksht 
Application.ScreenUpdating = False
Err.Clear
Application.StatusBar = 
False
j = 0
 
With ActiveWorkbook
Workbooks.Add
For i = 1 To 
c.Count
Range("A1").NumberFormatLocal = c(i)
.DeleteNumberFormat 
ActiveCell.NumberFormat
If Err = 0 Then j = j + 1 Else Err.Clear
Next 
i
MsgBox j & " format(s) inutilisé(s) supprimé(s).", vbInformation
End 
With
ActiveWorkbook.Close False
Shts.Select
End Sub