XL 2021 macro

[chinel]

Bonjour tout le monde, je cherche à faire une multiplication avec une macro. J'ai une cellule fusionnée (E5 F5) et quand j'écris par exemple 5 la macro m'affiche 5.000 . J'avais ceci mais cela ne fonctionne pas.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Not Intersect(Target, Range("E5").MergeArea) Is Nothing Then
If IsNumeric(Target.Value) Then
Application.EnableEvents = False
Target.Value = Target.Value * 1000
Target.NumberFormat = "0.000"
Application.EnableEvents = True
End If
End If
End If
End Sub

Besoin d'aide merci !

 

[Jacky67]

Bonjour tout le monde, je cherche à faire une multiplication avec une macro. J'ai une cellule fusionnée (E5 F5) et quand j'écris par exemple 5 la macro m'affiche 5.000 . J'avais ceci mais cela ne fonctionne pas.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Not Intersect(Target, Range("E5").MergeArea) Is Nothing Then
If IsNumeric(Target.Value) Then
Application.EnableEvents = False
Target.Value = Target.Value * 1000
Target.NumberFormat = "0.000"
Application.EnableEvents = True
End If
End If
End If
End Sub

Besoin d'aide merci !

**Post supprimé

 

[chinel]

Bonjour,
Cette macro fait exactement ce qui lui est demandée soit
La cellule active(Ici E5) * 1000 ==> Target.Value = Target.Value * 1000

chez moi, elle ne fonctionne pas et si je ne fusionne pas la E5 à F5 cela ne fonctionne pas non plus sûrement un problème dans ma macro

 

[TooFatBoy]

Bonjour,

je cherche à faire une multiplication avec une macro. J'ai une cellule fusionnée (E5 F5) et quand j'écris par exemple 5 la macro m'affiche 5.000 .

À essayer, à condition que ton séparateur de milliers soit le point (ce qui serait étonnant...) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count <> 1 Then Exit sub
If Target.address<>"$E$5" Then Exit sub
With target
If IsNumeric(.Value) Then
Application.EnableEvents = False
.Value = .Value * 1000
.NumberFormat = "#,##0"
Application.EnableEvents = True
End If
End with
End Sub



[edit] Jacky67, dont j'adore le pseudo... [/edit]

 

[Jacky67]

chez moi, elle ne fonctionne pas et si je ne fusionne pas la E5 à F5 cela ne fonctionne pas non plus sûrement un problème dans ma macro

Re..
Sur un Change plutôt que sur un SelectionChange

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("E5")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If IsNumeric(Target.Value) Then
        Application.EnableEvents = False
        Target.Value = Target.Value * 1000
        Target.NumberFormat = "0.000"
        Application.EnableEvents = True
    End If
    Application.EnableEvents = True
End Sub

*Hello TooFatBoy

 

[job75]

Bonjour à tous,

Avec ceci le séparateur de milliers devient le point :

Private Sub Worksheet_Change(ByVal Target As Range)
With [E5]
    If Intersect(Target, .Cells) Is Nothing Or Not IsNumeric(.Value) Then Exit Sub
    Application.ThousandsSeparator = "."
    Application.UseSystemSeparators = False
    .NumberFormat = "#,##0"
    Application.EnableEvents = False
    .Value = .Value * 1000
    Application.EnableEvents = True
End With
End Sub

A+

 

[chinel]

Bonjour et merci de vos réponses, mais celles-ci ne fonctionnent pas

 

[chinel]

j'ai trouvé ceci qui marche


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E5:F5")) Is Nothing Then
Application.EnableEvents = False
Dim cell As Range
For Each cell In Intersect(Target, Range("E5:F5"))
If IsNumeric(cell.Value) Then
cell.Value = cell.Value * 1000
cell.NumberFormat = "0.000"
End If
Next cell
Application.EnableEvents = True
End If
End Sub

 

[Staple1600]

Bonjour le fil @chinel, @Jacky67 , @TooFatBoy , @job75

A) Sans macro
1) Dans une cellule vide, saisir 1000
2) Faire Copier
3) Sélectionner E5:F5 -> Collage spécial -> Multiplication

B) Et si vraiment on veut macroter
Transcription en macro de ce que je décris en A)

Sub Macro1()
Range("I8") = "1000"
Range("I8").Copy
Range("E5:F5").PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply
End Sub

 

[job75]

Bonjour le forum,

En complément de mon post #6 j'ajoute dans ThisWorkbook :

Private Sub Workbook_Open()
Application.ThousandsSeparator = "."
Application.UseSystemSeparators = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.UseSystemSeparators = True 'applique les séparateurs système
End Sub

De cette manière les séparateurs système sont rétablis à la fermeture du fichier.

A+