XL 2021 macro

chinel · 2 Juin 2023

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 !

chinel · 3 Juin 2023

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 · 2 Juin 2023

chinel à dit:
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 · 2 Juin 2023

Jacky67 à dit:
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 · 2 Juin 2023

Bonjour,

chinel à dit:
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 · 2 Juin 2023

chinel à dit:
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 · 2 Juin 2023

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 · 3 Juin 2023

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

chinel · 3 Juin 2023

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 · 3 Juin 2023

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 · 3 Juin 2023

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+

XL 2021 macro

chinel

XLDnaute Impliqué

chinel

Jacky67

XLDnaute Barbatruc

chinel

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

Jacky67

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

chinel

XLDnaute Impliqué

chinel

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires