Discussion :

[mnarchi]

testé sous [Excel 2003] et [Excel 2007]
Le but de cette solution est d'ajouter un menu "Solutions-VBA" pour convertir les cellules sélectionnées. Ce nouveau menu apparaîtra à l'ouverture du fichier.

Dans un module indépendant, exemple Module1, coller le code suivant

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
84
85
86
87
88
89
90
91
92
Dim cel As Range
Public Sub Majuscule()
If TypeName(Selection) = "Range" Then
    For Each cel In Selection
        cel.Value = UCase(cel.Value)
    Next
End If
End Sub
 
Public Sub Minuscule()
If TypeName(Selection) = "Range" Then
    For Each cel In Selection
        cel.Value = LCase(cel.Value)
    Next
End If
End Sub
 
Public Sub NomPropre()
If TypeName(Selection) = "Range" Then
    For Each cel In Selection
        cel.Value = Application.WorksheetFunction.Proper(cel.Value)
    Next
End If
End Sub
 
Public Sub ModifMenu()
Dim Nom_Menu As String
Dim Nom_Commande As String
Dim TrouveMenu As Boolean
Dim TrouveCommande As Boolean
Nom_Menu = "Solutions-VBA"
Nom_Commande = "Casse"
TrouveMenu = False
TrouveCommande = False
Set BarreMenu = CommandBars("Worksheet menu Bar")
For Each Menu In BarreMenu.Controls
    If Menu.Caption = Nom_Menu Then
        TrouveMenu = True
    End If
Next
If TrouveMenu = False Then
    Set NouveauMenu = BarreMenu.Controls.Add(msoControlPopup)
    NouveauMenu.Caption = Nom_Menu
    Set NouvelleCommande = NouveauMenu.Controls.Add(msoControlPopup, , 3)
    NouvelleCommande.Caption = Nom_Commande
    Set SousMenu1 = NouvelleCommande.Controls.Add
    SousMenu1.Caption = "Majuscule"
    SousMenu1.OnAction = "Majuscule"
    Set SousMenu2 = NouvelleCommande.Controls.Add
    SousMenu2.Caption = "Minuscule"
    SousMenu2.OnAction = "Minuscule"
    Set SousMenu3 = NouvelleCommande.Controls.Add
    SousMenu3.Caption = "NomPropre"
    SousMenu3.OnAction = "NomPropre"
    Set BarreMenu = Nothing
    Set Menu = Nothing
    Set NouvelleCommande = Nothing
    Set SousMenu1 = Nothing
    Set SousMenu2 = Nothing
    Set SousMenu3 = Nothing
Else
    For Each Commande In BarreMenu.Controls(Nom_Menu).Controls
        If Commande.Caption = Nom_Commande Then
            TrouveCommande = True
        End If
    Next
    If TrouveCommande = False Then
        Set NouvelleCommande = BarreMenu.Controls(Nom_Menu).Controls.Add(msoControlPopup, , 3)
        NouvelleCommande.Caption = Nom_Commande
        Set SousMenu1 = NouvelleCommande.Controls.Add
        SousMenu1.Caption = "Majuscule"
        SousMenu1.OnAction = "Majuscule"
        Set SousMenu2 = NouvelleCommande.Controls.Add
        SousMenu2.Caption = "Minuscule"
        SousMenu2.OnAction = "Minuscule"
        Set SousMenu3 = NouvelleCommande.Controls.Add
        SousMenu3.Caption = "NomPropre"
        SousMenu3.OnAction = "NomPropre"
        Set BarreMenu = Nothing
        Set Menu = Nothing
        Set NouvelleCommande = Nothing
        Set SousMenu1 = Nothing
        Set SousMenu2 = Nothing
        Set SousMenu3 = Nothing
    End If
 
End If
End Sub
 
Public Sub RestaureMenu()
CommandBars("Worksheet menu Bar").Reset
End Sub

ensuite dans le module rattaché à ThisWorkbook, coller le code suivant

Code :

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

1
2
3
4
5
6
7
Private Sub Workbook_BeforeClose(Cancel As Boolean)
RestaureMenu
End Sub
 
Private Sub Workbook_Open()
ModifMenu
End Sub

je reste à votre diposition pour des renseignements complémentaires.

[Vadorblanc]

Super joli programme
Félicitations

[mnarchi]

merci!

d'autres contributions seront publiées bientôt

[fring]

Bonjour,

joli

Tu pourrais ajouter une option légèrement différente de la fonction "Nom Propre", l'option de mettre une majuscule en début de phrase :

Code :

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

1
2
3
4
5
6
7
Public Sub Maj_debut_phrase()
If TypeName(Selection) = "Range" Then
    For Each cel In Selection
        cel.Value = UCase(Left(cel, 1)) & Right(cel, Len(cel) - 1)
    Next
End If
End Sub

[mnarchi]

merci!

J'ai aussi prévu une autre solution qui supprime les accents lors du passage en majuscule etc...

Elle est en cours de test