Euh... c'est 53 semaines !
Merci, j'attends avec impatiente
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
O@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°6n° 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
Parfait, je vais m'en sortir avec des copier coller.@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°6n° 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
Parfait
pour appliquer cette macro à plusieurs cellules, je peux modifier facilement
pour l'instant c'est uniquement la cellule B1
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
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.@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°6n° 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
Que voulez-vous dire ? Ma méthode fonctionne au contraire très bien avec le copier-coller.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.
ta solution est super, car elle supporte les copier coller
Dommage Soan, que pour 51 et 52 c'est pas bon.
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
ChrW()
au lieu de mon précédent Evaluate()
➯ c'est bien plus simple ! merci job75 !