1 pièce(s) jointe(s)
Suppression des formats non utilisés EXCEL code à mettre à jour
Bonjour à tous :D
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:
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 |
