XL 2019 transformation automatique de caractère.

Océane

Océane

XLDnaute Impliqué
je cherche une police qui encercle mes nombres au fur et mesure de la frappe.
Exemple dans le fichier joint
Merci d'avance
 

Pièces jointes

  • 7.xlsx
    10.5 KB · Affichages: 13
Trier par date Trier par votes
S

soan

XLDnaute Barbatruc
Inactif
TooFatBoy à dit:
Euh... c'est 53 semaines ! 🤡
Cliquez pour agrandir...

Image.jpg


bon, on va pas chipoter pour 0,1429 semaine ! 😄

soan
 
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
@Océane

1) même présentation que celle de mon fichier précédent

2) en B1 : saisis un nombre de 1 à 53

pour faire plaisir à Océane et à n° 6 n° 47267 TooFatBoy ! 😇

à te lire pour avoir ton avis. ;)


code VBA de "Feuil1" (19 lignes)

VB: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim v%, k%
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Address(0, 0) <> "B1" Then Exit Sub
    v = Val(.Value): If v < 1 Or v > 53 Then Exit Sub
    k = 9311 - 3549 * (v > 20) - 81 * (v > 35)
    Application.EnableEvents = 0
    If v <= 50 Then
      .Value = Evaluate("=UNICHAR(" & k + v & ")")
    Else
      .Value = Evaluate("=UNICHAR(12991)") & "+" _
        & Evaluate("=UNICHAR(" & 9261 + v & ")")
    End If
    Application.EnableEvents = -1
  End With
End Sub

soan
 

Pièces jointes

  • Océane Exo v4.xlsm
    16.8 KB · Affichages: 9
Vote positif 0 Vote négatif
Océane

Océane

XLDnaute Impliqué
soan à dit:
@Océane

1) même présentation que celle de mon fichier précédent

2) en B1 : saisis un nombre de 1 à 53

pour faire plaisir à Océane et à n° 6 n° 47267 TooFatBoy ! 😇

à te lire pour avoir ton avis. ;)


code VBA de "Feuil1" (19 lignes)

VB: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim v%, k%
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Address(0, 0) <> "B1" Then Exit Sub
    v = Val(.Value): If v < 1 Or v > 53 Then Exit Sub
    k = 9311 - 3549 * (v > 20) - 81 * (v > 35)
    Application.EnableEvents = 0
    If v <= 50 Then
      .Value = Evaluate("=UNICHAR(" & k + v & ")")
    Else
      .Value = Evaluate("=UNICHAR(12991)") & "+" _
        & Evaluate("=UNICHAR(" & 9261 + v & ")")
    End If
    Application.EnableEvents = -1
  End With
End Sub

soan
Cliquez pour agrandir...
O
soan à dit:
@Océane

1) même présentation que celle de mon fichier précédent

2) en B1 : saisis un nombre de 1 à 53

pour faire plaisir à Océane et à n° 6 n° 47267 TooFatBoy ! 😇

à te lire pour avoir ton avis. ;)


code VBA de "Feuil1" (19 lignes)

VB: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim v%, k%
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Address(0, 0) <> "B1" Then Exit Sub
    v = Val(.Value): If v < 1 Or v > 53 Then Exit Sub
    k = 9311 - 3549 * (v > 20) - 81 * (v > 35)
    Application.EnableEvents = 0
    If v <= 50 Then
      .Value = Evaluate("=UNICHAR(" & k + v & ")")
    Else
      .Value = Evaluate("=UNICHAR(12991)") & "+" _
        & Evaluate("=UNICHAR(" & 9261 + v & ")")
    End If
    Application.EnableEvents = -1
  End With
End Sub

soan
Cliquez pour agrandir...
Parfait, je vais m'en sortir avec des copier coller.
Si non pour appliquer cette macro a plusieurs cellules, je peux modifier facilement; pour l'instant c'est uniquement (B1)
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour à tous,

Voyez le fichier joint et cette macro dans le code de la 1ère feuille :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, [A:A], UsedRange)
If Target Is Nothing Then Exit Sub
Dim o As Object, c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
'---RAZ---
For Each o In DrawingObjects
    If Not Intersect(o.TopLeftCell, Target) Is Nothing Then o.Delete
Next
'---copier-coller---
Set c = Sheets("MODELE").[A1]
For Each Target In Target 'si entrées/effacements multiples
    If Target Like "#" Or Target Like "##" Then
        c = Target
        c.Copy Target
    End If
Next
Application.EnableEvents = True 'réactive les évènements
End Sub
L'avantage de cette méthode c'est que les nombres entrés sont utilisables, ce qui n'est pas le cas avec la fonction UNICAR qui renvoie un texte.

Et bien sûr tous les nombres avec 1 ou 2 chiffres sont traités.

A+
 

Pièces jointes

  • Test(1).xlsm
    20.1 KB · Affichages: 7
Vote positif 0 Vote négatif
Océane

Océane

XLDnaute Impliqué
soan à dit:
@Océane

1) même présentation que celle de mon fichier précédent

2) en B1 : saisis un nombre de 1 à 53

pour faire plaisir à Océane et à n° 6 n° 47267 TooFatBoy ! 😇

à te lire pour avoir ton avis. ;)


code VBA de "Feuil1" (19 lignes)

VB: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim v%, k%
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Address(0, 0) <> "B1" Then Exit Sub
    v = Val(.Value): If v < 1 Or v > 53 Then Exit Sub
    k = 9311 - 3549 * (v > 20) - 81 * (v > 35)
    Application.EnableEvents = 0
    If v <= 50 Then
      .Value = Evaluate("=UNICHAR(" & k + v & ")")
    Else
      .Value = Evaluate("=UNICHAR(12991)") & "+" _
        & Evaluate("=UNICHAR(" & 9261 + v & ")")
    End If
    Application.EnableEvents = -1
  End With
End Sub

soan
Cliquez pour agrandir...
ta solution est super, car elle supporte les copier coller, contrairement a celle de Job45 qui fonctionne aussi très bien, mais après un copier coller c'est pas top.
Dommage Soan, que pour 51 et 52 c'est pas bon.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Océane à dit:
ta solution est super, car elle supporte les copier coller, contrairement a celle de Job45 qui fonctionne aussi très bien, mais après un copier coller c'est pas top.
Cliquez pour agrandir...
Que voulez-vous dire ? Ma méthode fonctionne au contraire très bien avec le copier-coller.

C'est pour ça qu'il y a la boucle For Each Target In Target.

Voyez le fichier joint, copiez la plage H2:H5 et collez-la en A2.

PS : mon pseudo est job75.
 

Pièces jointes

  • Test(2).xlsm
    20.2 KB · Affichages: 7
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
@Océane

Océane à dit:
ta solution est super, car elle supporte les copier coller
Cliquez pour agrandir...

merci pour ton retour ! 😊


Océane à dit:
Dommage Soan, que pour 51 et 52 c'est pas bon.
Cliquez pour agrandir...

tu n'as pas aimé les additions pour 51 à 53 ? 😁 😂 🤣

Image 1.jpg


bon, si tu n'as pas aimé, alors tu peux simplifier ainsi la macro :​

code VBA (14 lignes) :

VB: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim v%, k%
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Address(0, 0) <> "B1" Then Exit Sub
    v = Val(.Value): If v < 1 Or v > 50 Then Exit Sub
    k = 9311 - 3549 * (v > 20) - 81 * (v > 35)
    Application.EnableEvents = 0
    .Value = ChrW(k + v)
    Application.EnableEvents = -1
  End With
End Sub

mais cette fois, bien sûr, c'est que les nombres 1 à 50
qui seront entourés ; ça fera plus rien pour 51 à 53.

bien sûr, j'ai modifié le texte entre parenthèses :

Image 2.jpg



edit : j'ai suivi le très bon conseil du post #27 de job75 : j'ai utilisé ChrW() au lieu de mon précédent Evaluate() ➯ c'est bien plus simple ! :) 👍 merci job75 ! 👏​

soan
 

Pièces jointes

  • Océane Exo v5.xlsm
    16.6 KB · Affichages: 3
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

H
  • Résolu(e)
Microsoft 365 Archivage automatique sous condition (Macro)
Réponses
2
Affichages
307
HugoLaChips
H
B
  • Question
XL 2019 numerotation et nommination automatique facture
Réponses
4
Affichages
417
bauerjackob
B
N
  • Résolu(e)
XL 2021 Somme cumulative en prenant en compte une colonne sur 3
Réponses
3
Affichages
119
NLSCt
N
E
  • Question
Microsoft 365 utilisation de la fonction rechercher/remplacer pour ajouter un caractère d'annihilation par ' en amont de chaque contenu de la cellule
Réponses
2
Affichages
126
elgringo123456
E
F
  • Question
XL pour MAC Comment suivre un budget et un budget réalisé à jour simplement ?
Réponses
4
Affichages
149
florestan75
F
F
  • Question
Microsoft 365 Copier des données en décalant des cellules
Réponses
6
Affichages
189
Frank Bellaisch
F
M
  • Question
XL 2019 Réaliser un classement automatique pour un tournoi enfants à Mario Kart
Réponses
2
Affichages
179
michel8032
M
D
  • Question
Microsoft 365 Épurer les lignes vides d'une cellule puis fractionner la cellule en plusieurs lignes
2
Réponses
20
Affichages
285
fanch55
fanch55
C
  • Résolu(e)
XL 2019 Automatiser des formules
Réponses
4
Affichages
190
cotignac
C
halecs93
  • Résolu(e)
XL 2016 incrémentation et numérotation automatique
Réponses
7
Affichages
265
halecs93
halecs93

Membres actuellement en ligne

1 membres et 34 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 248
Messages
2 086 593
Membres
103 248
dernier inscrit
Happycat