XL 2021 macro

chinel

XLDnaute Impliqué
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 !
 
Solution
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

Jacky67

XLDnaute Barbatruc
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é
 

TooFatBoy

XLDnaute Barbatruc
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]
 
Dernière édition:

Jacky67

XLDnaute Barbatruc
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
VB:
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

XLDnaute Barbatruc
Bonjour à tous,

Avec ceci le séparateur de milliers devient le point :
VB:
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

XLDnaute Impliqué
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

XLDnaute Barbatruc
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)
VB:
Sub Macro1()
Range("I8") = "1000"
Range("I8").Copy
Range("E5:F5").PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply
End Sub
 

job75

XLDnaute Barbatruc
Bonjour le forum,

En complément de mon post #6 j'ajoute dans ThisWorkbook :
VB:
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+
 

Pièces jointes

  • Test.xlsm
    16.5 KB · Affichages: 2

Discussions similaires

Réponses
1
Affichages
204