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

[Menhir]

Le code date un peu et ne fonctionne pas sur excel 2010.

Quels éléments ne fonctionnent pas.

[Marc-L]

Bonjour !

Le code date un peu et ne fonctionne pas sur excel 2010.

Aucun rapport avec la version d'Excel ‼     Trouver un code forcément ne correspondant pas au besoin ou au contexte …
Des codes fonctionnant sur Excel 2003 continuent encore de fonctionner sur les versions supérieures …

Activer l'Enregistreur de macro puis opérer manuellement :  une base de code est livrée sur un plateau !

___________________________________________________________________________________________________________
Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

[iixii]

Bonjour

Merci pour votre aide.

Ci-joint la partie du code qui apparait en rouge lorsque je l'intègre dans un macro :

Code :

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

Dim dObj As New DataObject, c As New Collection Dim Wksht As Worksheet, Cell As Range, Shts As Sheets

et à la fin :

Code :

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

Next Wksht Application.ScreenUpdating = False

Merci encore

Je ne peux pas enregistrer cette macro car il y a des conditions : si cellule excel vide de caractère alors j'efface le format.

Test 2.xlsm

[clementmarcotte]

Bonjour

Code :

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

Dim dObj As New DataObject, c As New Collection Dim Wksht As Worksheet, Cell As Range, Shts As Sheets

Code :

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

Next Wksht Application.ScreenUpdating = False

On ne peut pas avoir deux dim sur la même ligne sans mettre un deux-points avant le second dim

Code :

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

Dim dObj As New DataObject, c As New Collection :  Dim Wksht As Worksheet, Cell As Range, Shts As Sheets

Mais comme c'était pour économiser la mémoire vive; aujourd'hui c'est plutôt désuet.

Code :

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

1
2
Dim dObj As New DataObject, c As New Collection
Dim Wksht As Worksheet, Cell As Range, Shts As Sheets

Même chose pour ton autre ligne

Code :

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

Next Wksht :  Application.ScreenUpdating = False

Code :

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

1
2
Next Wksht
Application.ScreenUpdating = False

[patricktoulon]

re
un clear sur les cellules vides ne serait pas plus simple ????