Excel 2013 Remplacer automatiquement un nombre par une lettr

Bonjour à tous !

Cela fait maintenant deux jours que je recherche la réponse à ma question en vain. Ce n'est pas très facile à expliquer, mais je vais essayer d'être le plus clair possible.

Dans un tableau, je cherche à ce que, dès que je tape le chiffre "1" dans la cellule A1 par exemple, celui-ci soit directement remplacé par une lettre en police Webdings.

J'aimerai en fait, cette correspondance : (un chiffre = une lettre Webdings)

- "1" dans la cellule A1 après avoir appuyé sur entrée deviendrait automatiquement ">" avec la police Webdings dans cette même cellule A1

- "2" dans la cellule A1 => "&" avec la police Webdings dans cette même cellule A1

- "3" dans la cellule A1 => "º" avec la police Webdings dans cette même cellule A1

- "4" dans la cellule A1 => "(" avec la police Webdings dans cette même cellule A1

- "5" dans la cellule A1 => "U" avec la police Webdings dans cette même cellule A1

- "6" dans la cellule A1 => "V" avec la police Webdings dans cette même cellule A1

J'aurai ensuite souhaité que ce "remplacement automatique" soit automatique pour les cellules "$H$3:$BB$32"

En espérant que l'un d'entre vous puisse m'aider !

Bonjour

En espérant que cela te conviennes

Cordialement

Bonjour,

Une proposition avec une procédure évènementielle (VBA) à placer dans le module de la feuille active.

Cdlt.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim choice As Long

    If Target.Count > 1 Then Exit Sub

    If Not Intersect(Target, Range("H3:BB32")) Is Nothing Then
        Select Case Target.Value
            Case 1 To 6
                choice = Choose(Target.Value, 62, 38, 176, 40, 85, 86)
                With Target
                    .Value = Chr(choice)
                    .Font.Name = "Wingdings"
                End With
            Case vbNullString
                Target.Style = "Normal"
            Case Else
                '
        End Select
    End If

End Sub

Merci de votre contribution Jean-Eric !

Sur un autre site, je suis parvenu à trouver (pensais-je) la solution à mon problème avec le code ci-dessous

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Selection, Range("H3:BB32")) Is Nothing Then
    If Target.Value = 1 Then
    Target = "h"
    ElseIf Target.Value = 2 Then
    Target = "e"
    ElseIf Target.Value = 3 Then
    Target = "N"
    ElseIf Target.Value = 4 Then
    Target = "("
    ElseIf Target.Value = 5 Then
    Target = "-"
    ElseIf Target.Value = 6 Then
    Target = "F"
    Target.Font.Name = "Wingdings"
     Else
    Target.Font.Name = "Calibri"
    End If
  End If
End Sub

Malheureusement, cela ne fonctionne que pour le "6". Il s'agit du seul nombre compris entre 1 et 6 que j'inscris dans une cellule et me donne le résultat escompté (symbole wingdings). Pourriez-vous m'expliquer pourquoi cela ne fonctionne pas pour les autres ?

Re,

Ta procédure revue.

Comprends-tu ?

Ma proposition ne te satisfait elle pas ?

Cdlt.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As String

    If Not Intersect(Target, Range("H3:BB32")) Is Nothing Then
        If Target.Value = 1 Then
            x = "h"
        ElseIf Target.Value = 2 Then
            x = "e"
        ElseIf Target.Value = 3 Then
            x = "N"
        ElseIf Target.Value = 4 Then
            x = "("
        ElseIf Target.Value = 5 Then
            x = "-"
        ElseIf Target.Value = 6 Then
            x = "F"
        Else
            x = ""
        End If
    End If

    If x <> "" Then
        Target.Font.Name = "Wingdings"
    Else
        Target.Font.Name = "Calibri"
    End If

End Sub

Bonsoir !

Je vous comprends mieux oui ! Sauf qu'en essayant ce code, peu importe le nombre compris entre 1 et 6, le résultat est toujours une paire de ciseaux en symbole... Savez-vous pourquoi ?

Re,

Ce que j'ai de mon côté.

Cdlt

J'ai oublié :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As String

    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("H3:BB32")) Is Nothing Then

Bonjour,

Une piste similaire. Attention tout de même, Jean-Eric utilise la fonte "Wingdings" et non "Webdings" :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim OK As Boolean

    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    Select Case Target.Value

        Case 1: Target.Value = ">": OK = True
        Case 2: Target.Value = "&": OK = True
        Case 3: Target.Value = "°": OK = True
        Case 4: Target.Value = "(": OK = True
        Case 5: Target.Value = "U": OK = True
        Case 6: Target.Value = "V": OK = True

    End Select

    With Target.Font
        If OK = True Then: .Name = "Webdings": Else .Name = "Calibri"
    End With

    Application.EnableEvents = True

End Sub

Bonsoir à vous !

J'ai encore passé pas mal de temps sur mon truc et j'y suis parvenu !

En fait, j'avais posté mon problème sur un autre site et le code VBA ne fonctionnait pas non plus. En combinant le code que vous m'avez donné tous les deux et celui de l'autre site, tout a fonctionné !

Voici le code si cela vous intéresse :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim x As String

If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("H3:BB32")) Is Nothing Then

If Target.Value = 1 Then

Target = "?"

ElseIf Target.Value = 2 Then

Target = "e"

ElseIf Target.Value = 3 Then

Target = "%"

ElseIf Target.Value = 4 Then

Target = "("

ElseIf Target.Value = 5 Then

Target = "."

ElseIf Target.Value = 6 Then

Target = "F"

End If

If Target > "" Then

Target.Font.Name = "Wingdings"

Else

Target.Font.Name = "Calibri"

End If

End If

End Sub

Merci beaucoup pour votre aide en tout cas !!!

Bonjour à ceux que ça peut intéresser !

Finalement, l'ancien code remplace toute inscription dans une cellule par une police Wingdings. Si, comme moi, vous avez plusieurs variables (de 1 à 6 et plusieurs lettres) il faut préciser sur VBA quelles données doivent être retranscrites en Wingdings avec le code suivant :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As String
 If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("H3:BB32")) Is Nothing Then
        If Target.Value = 1 Then
            Target = "h"
            Target.Font.Name = "Wingdings"
        ElseIf Target.Value = 2 Then
            Target = "e"
            Target.Font.Name = "Wingdings"
        ElseIf Target.Value = 3 Then
            Target = "%"
            Target.Font.Name = "Wingdings"
        ElseIf Target.Value = 4 Then
            Target = "("
            Target.Font.Name = "Wingdings"
        ElseIf Target.Value = 5 Then
            Target = "."
            Target.Font.Name = "Wingdings"
        ElseIf Target.Value = 6 Then
            Target = "F"
            Target.Font.Name = "Wingdings"

 End If
    End If
En sub

Pour les lettres, je voulais que lorsque je tape "P", un "P" apparaisse dans une cellule colorisée en vert. Une simple mise en forme conditionnelle suffit !