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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
'Variable globale
Dim Choisi As Integer
'Quand on clique sur OK
Private Sub CommandButton1_Click()
' Trouve la dernière case dite "écrite" de la première colonne et sélectionne le tout
DernierTitre = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
MAJ = DernierTitre
Range("A1", Cells(1, DernierTitre)).Select
' Met le tout en gras et change la couleur en jaune
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
' Place le nombre de lignes "écrites" dans une variable et sélectionne la case
' la case correspondant à la dernière ligne et la dernière colonne, pour étendre
' la sélection jusqu'à la première case
DerniereLigne = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
Cells(DerniereLigne, DernierTitre).Select
Range("A1", Cells(DerniereLigne, DernierTitre)).Select
' Quadrille le tableau
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' Sélectionne toutes les cases et ajuste les lignes et colonnes
Cells.Select
Selection.Columns.AutoFit
Selection.Rows.AutoFit
' Fige la première ligne et resélectionne la première case
Cells(2, 1).Select
ActiveWindow.FreezePanes = True
Range("A1").Select
'Selection des majuscules
If Choisi = 0 Then
' Met tous les titres en majuscule
For Each MAJ In Range("A1", Cells(1, MAJ))
MAJ.Value = UCase(MAJ.Value)
Next MAJ
Choisi = -1
ElseIf Choisi = 1 Then
' Met tous les titres avec la première lettre en majuscule
Dim Valeur As String
Dim Plage, Cellule As Range
Set Plage = Range("A1", Cells(1, DernierTitre))
For Each Cellule In Plage
Valeur = Mid(Cellule.Value, 2)
Valeur = LCase(Valeur)
Valeur = UCase(Mid(Cellule.Value, 1, 1)) & Valeur
Cellule.Value = Valeur
Next Cellule
Choisi = -1
ElseIf Choisi = 2 Then
' Met tout le tableau en majuscule
DerniereLigne = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
For Each c In Range("A1", Cells(DerniereLigne, DernierTitre))
c.Value = UCase(c.Value)
Next c
Choisi = -1
End If
Unload UserForm1
End Sub
'Quand on clique sur le bouton ANNULER
Private Sub CommandButton2_Click()
Unload UserForm1
End Sub
'Quand on choisit l'option "La premère lettre des titres en majuscule"
Private Sub L_T_Maj_Click()
Choisi = 1
End Sub
'Quand on choisit l'option "Tous les titres en Majuscule"
Private Sub T_T_MAJ_Click()
Choisi = 0
End Sub
'Quand on choisit l'option "Tout le tableau en majuscule"
Private Sub T_TAB_MAJ_Click()
Choisi = 2
End Sub |
[VBA-E]Message d'erreur lors de l'affectation d'une macro + prob form
) mais...
Répondre avec citation
Envoyé par Aide en ligne Excel
???????????
Partager