Microsoft 365 SYMBOLE MONETAIRE

[nikkho]

Bonjour. Je travaille sur des tableurs de prix avec trois devises régulières. Est il possible d'avoir un raccourci ou boutton automatique pour convertir une valeur monétaire ou un nombre directement en chiffre. C'ets possible avec le $ ou € de base mais j'aurais besoin du R sud-africain également et je voudrais savoir s'il y a avait un moyen d'obtenir un raccourci au lieu d'aller sélectionner la cellule et d'aller dans le menu " nombre" "categorie" "monnaie" etc. merci d'avance de vos lumières . bien cordialement

 

[fanch55]

Bonjour,
mettez les cellules ou colonnes concernées en format Monétaire 2 décimales
puis insérez le code joint dans le module de votre feuille .
Par la suite, en faisant un clic droit sur une cellule "monétaire" de votre feuille, vous aurez des options supplémentaire pour formater celle-ci

Il y a 2 sub possibles associées aux options : Set_Symbol et Set_Symbol2 à préciser dans les OnAction des boutons. A vous de choisir ou de les modifier ...

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Cbar    As CommandBarControl
Dim Rbar    As CommandBar
Const Cb = "RightClick"

    If Target.Count = 1 Then
        If Evaluate("=Cell(""format""," & Target.Address & ")") Like "C*" _
        Or Evaluate("=Cell(""format""," & Target.Address & ")") Like ",*" _
        Or Evaluate("=Cell(""format""," & Target.Address & ")") Like "F*" Then
            Cancel = True
            On Error Resume Next: CommandBars(Cb).Delete: On Error GoTo 0
            Set Rbar = CommandBars.Add(Cb, msoBarPopup, , True)
            With Rbar
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .Caption = "Euro"
                    .FaceId = 1408: .OnAction = Me.CodeName & ".Set_Symbol"
                End With
                With .Controls.Add(msoControlButton, 1, , 2, True)
                    .Caption = "Dollar"
                    .FaceId = 1408: .OnAction = Me.CodeName & ".Set_Symbol"
                End With
                With .Controls.Add(msoControlButton, 1, , 3, True)
                    .Caption = "Rand"
                    .FaceId = 1408: .OnAction = Me.CodeName & ".Set_Symbol"
                End With
                .Controls.Add(msoControlButton, 1, , 4, True).BeginGroup = True
              ' On recopie les controles standards du double_clic sur Cellule
                For Each Cbar In CommandBars("Cell").Controls
                   Cbar.Copy Rbar
                Next
               ' Affichage du menu contextuel
               .ShowPopup
               .Delete
            End With
        End If
    End If
End Sub
Sub Set_Symbol2()
    Select Case Application.CommandBars.ActionControl.Caption
        Case "Euro":    Selection.NumberFormat = "# ##0.00 [$EUR]"
        Case "Dollar":  Selection.NumberFormat = "# ##0.00 [$USD]"
        Case "Rand":    Selection.NumberFormat = "# ##0.00 [$ZAR]"
    End Select
End Sub
Sub Set_Symbol()
    Select Case Application.CommandBars.ActionControl.Caption
        Case "Euro":    Selection.NumberFormat = "# ##0.00 €"
        Case "Dollar":  Selection.NumberFormat = "# ##0.00 $"
        Case "Rand":    Selection.NumberFormat = "[$R-436]# ##0.00"
    End Select
End Sub

 

[nikkho]

Bonsoir.
MIlle merci. quel code. ça a du vous prendre un temps fou.
Une petite question néanmoins.. tout se passe bien, excepté que le symbole $ n'apparait pas quand je sélectionne cette devise. Etant loin d'avoir la meme aisance au niveau du codage que vous, quelle est la manip à faire pour réparer ce fait. Egalement, pour être tout à fait clair, pour ce code, il faut bien que j'aille sur "developer" "VBA". et après je sélectionne quoi comme option pour que le code soit applicable dans l'intégralité du doc excel et tous ses onglets? comme vous le voyez, vous parlez à un néophite bonne soirée

 

[fanch55]

Spoiler: A mettre dans un Module de votre classeur

Option Explicit
Option Compare Text
Sub W_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim CBar    As CommandBarControl
Dim Rbar    As CommandBar
Dim M       As String
Const Cb = "RightClick"
    If Target.Count = 1 Then
        M = Evaluate("=Cell(""format""," & Target.Address & ")")
        If M Like "C*" Or M Like "F*" Or M Like ",*" Then
            Cancel = True
            On Error Resume Next: CommandBars(Cb).Delete: On Error GoTo 0
            Set Rbar = CommandBars.Add(Cb, msoBarPopup, , True)
            With Rbar
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .Caption = "Euro"
                    .FaceId = 1408: .OnAction = "Set_Symbol"
                End With
                With .Controls.Add(msoControlButton, 1, , 2, True)
                    .Caption = "Dollar"
                    .FaceId = 1408: .OnAction = "Set_Symbol"
                End With
                With .Controls.Add(msoControlButton, 1, , 3, True)
                    .Caption = "Rand"
                    .FaceId = 1408: .OnAction = "Set_Symbol"
                End With
                .Controls.Add(msoControlButton, 1, , 4, True).BeginGroup = True
              ' On recopie les controles standards du double_clic sur Cellule
                M = IIf(Target.ListObject Is Nothing, "Cell", "List Range Popup")
                For Each CBar In CommandBars(M).Controls
                   CBar.Copy Rbar
                Next
               ' Affichage du menu contextuel
               .ShowPopup
               .Delete
            End With
        End If
    End If
End Sub
Sub Set_Symbol2()
    Select Case Application.CommandBars.ActionControl.Caption
        Case "Euro":    Selection.NumberFormat = "# ##0.00 [$EUR]"
        Case "Dollar":  Selection.NumberFormat = "# ##0.00 [$USD]"
        Case "Rand":    Selection.NumberFormat = "# ##0.00 [$ZAR]"
    End Select
End Sub
Sub Set_Symbol()
    Select Case Application.CommandBars.ActionControl.Caption
        Case "Euro":    Selection.NumberFormat = "# ##0.00 [$€-40C]"
        Case "Dollar":  Selection.NumberFormat = "# ##0.00 [$$-409]"
        Case "Rand":    Selection.NumberFormat = "# ##0.00 [$R-436]"
    End Select
End Sub

Spoiler: A mettre dans le code de la feuille

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    W_BeforeRightClick Target, Cancel
End Sub

Mise en œuvre :

Sélectionner une cellule et lui assigner un format monétaire
Puis faire clic droit sur la cellule et choisir le symbole

Classeur joint pour Exemple