Remplacer un bouton d'execution

**ancien1957** · 26/10/2017, 18h23

Bonjour,
comment dois-je faire pour supprimer le bouton d'exécution de macro pour le remplacer par du code VBA, c'est-à-dire que dès que je change le contenu d'une cellule (K1 par exemple), la macro se déclenchera automatiquement.
Voici mon code:
[CODE]Sub Combine()

Dim DerniereLigne As Long
Dim J As Integer
Dim MesOnglets As Variant
Dim ShSynthese As Worksheet
Dim MaPlage As Range

On Error Resume Next

MesOnglets = Array("Classe 1", "Classe 2", "Classe 3", "Classe 4")
Set ShSynthese = Worksheets.Add(before:=Sheets(1))
With ShSynthese
For J = LBound(MesOnglets) To UBound(MesOnglets)
DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 0
With Sheets(MesOnglets(J)).UsedRange
Set MaPlage = .Offset(1, 0).Resize(.Rows.Count - 1)
MaPlage.Copy Destination:=ShSynthese.Cells(DerniereLigne + 1, 1)
Set MaPlage = Nothing
End With
Next J
End With
Set ShSynthese = Nothing
Sheets(1).Name = "Combined"
ActiveSheet.Buttons.Add(658.5, 53.25, 61.5, 21.75).Select
Selection.OnAction = "Macro6"

End Sub

Sub Macro4()
'
' Macro4 Macro
'

'
Range("A2

200").Select
ActiveWorkbook.Worksheets("Combined").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Combined").Sort.SortFields.Add Key:=Range("C2:C200") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Combined").Sort
.SetRange Range("A2

200")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub

[/CODE

Sub Macro6()
'
' Macro6 Macro
'

'
Range("A1").Select
ActiveCell.FormulaR1C1 = "Noms"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Classe"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Moyenne"
Columns("B

").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "Rang"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=RANK(RC[-1],R2C3:R36C3,0)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2

36"), Type:=xlFillDefault
Range("D2

36").Select
ActiveWindow.SmallScroll Down:=-27
Range("A1

37").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("B2").Select
ActiveWindow.SmallScroll Down:=-15
Range("A1

37").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1").Select

End Sub

**unparia** · 26/10/2017, 18h29

Bonjour
Je n'ai pas lu ton code (non indenté entre balises code) et me suis arrêté à ceci :

c'est-à-dire que dès que je change le contenu d'une cellule (K1 par exemple), la macro se déclenchera automatiquement.

utilise alors la procédure évènementielle Worksheet_Change pour appeler ta macro si changement. En te rappelant que l'objet Target est la cellule concernée par cet évènement.

**ancien1957** · 27/10/2017, 10h33

Dois-je écrire ceci?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("K1")) Is Nothing Then
Call Combine
Calle Macro4
Call Macro6

Voici mon code:
Sub Combine()

Dim DerniereLigne As Long
Dim J As Integer
Dim MesOnglets As Variant
Dim ShSynthese As Worksheet
Dim MaPlage As Range

On Error Resume Next

MesOnglets = Array("Classe 1", "Classe 2", "Classe 3", "Classe 4")
Set ShSynthese = Worksheets.Add(before:=Sheets(1))
With ShSynthese
For J = LBound(MesOnglets) To UBound(MesOnglets)
DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 0
With Sheets(MesOnglets(J)).UsedRange
Set MaPlage = .Offset(1, 0).Resize(.Rows.Count - 1)
MaPlage.Copy Destination:=ShSynthese.Cells(DerniereLigne + 1, 1)
Set MaPlage = Nothing
End With
Next J
End With
Set ShSynthese = Nothing
Sheets(1).Name = "Combined"
ActiveSheet.Buttons.Add(658.5, 53.25, 61.5, 21.75).Select
Selection.OnAction = "Macro6"

End Sub

Sub Macro4()
'
' Macro4 Macro
'

'
Range("A2200").Select
ActiveWorkbook.Worksheets("Combined").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Combined").Sort.SortFields.Add Key:=Range("C2:C200") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Combined").Sort
.SetRange Range("A2200")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub

Sub Macro6()
'
' Macro6 Macro
'

'
Range("A1").Select
ActiveCell.FormulaR1C1 = "Noms"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Classe"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Moyenne"
Columns("B").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "Rang"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=RANK(RC[-1],R2C3:R36C3,0)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D236"), Type:=xlFillDefault
Range("D236").Select
ActiveWindow.SmallScroll Down:=-27
Range("A137").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("B2").Select
ActiveWindow.SmallScroll Down:=-15
Range("A137").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1").Select

End Sub

**unparia** · 27/10/2017, 12h05

Je ne lirai pas ton code (déjà dit) tant que non présenté indenté et entre balises code !
Présente-le donc ainsi , si tu veux mon aide. Tel que présenté, ton code me donne le tournis et est cause de torticolis (et mon âge est très avancé) .

**ancien1957** · 27/10/2017, 12h47

Dois-je écrire ceci ?
[Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("K1")) Is Nothing Then
Call Combine
Calle Macro4
Call Macro6CODE][/CODE]

Voici mon code Combine :
[CODESub Combine()

Dim DerniereLigne As Long
Dim J As Integer
Dim MesOnglets As Variant
Dim ShSynthese As Worksheet
Dim MaPlage As Range

On Error Resume Next

MesOnglets = Array("Classe 1", "Classe 2", "Classe 3", "Classe 4")
Set ShSynthese = Worksheets.Add(before:=Sheets(1))
With ShSynthese
For J = LBound(MesOnglets) To UBound(MesOnglets)
DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 0
With Sheets(MesOnglets(J)).UsedRange
Set MaPlage = .Offset(1, 0).Resize(.Rows.Count - 1)
MaPlage.Copy Destination:=ShSynthese.Cells(DerniereLigne + 1, 1)
Set MaPlage = Nothing
End With
Next J
End With
Set ShSynthese = Nothing
Sheets(1).Name = "Combined"
ActiveSheet.Buttons.Add(658.5, 53.25, 61.5, 21.75).Select
Selection.OnAction = "Macro6"

End Sub][/CODE]

Voici mon code Macro4
[CODESub Macro4()
'
' Macro4 Macro
'

'
Range("A2200").Select
ActiveWorkbook.Worksheets("Combined").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Combined").Sort.SortFields.Add Key:=Range("C2:C200") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Combined").Sort
.SetRange Range("A2200")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub][/CODE]

et voici mon code Macro6 :
[CODESub Macro6()
'
' Macro6 Macro
'

'
Range("A1").Select
ActiveCell.FormulaR1C1 = "Noms"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Classe"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Moyenne"
Columns("B").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "Rang"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=RANK(RC[-1],R2C3:R36C3,0)"
Range("D2").Select
Selection.AutoFill Destination:=Range("D236"), Type:=xlFillDefault
Range("D236").Select
ActiveWindow.SmallScroll Down:=-27
Range("A137").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("B2").Select
ActiveWindow.SmallScroll Down:=-15
Range("A137").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1").Select

End Sub][/CODE]

Merci beaucoup

**unparia** · 27/10/2017, 13h15

Je ne lirai pas ton code (déjà dit) tant que non présenté indenté et entre balises code !

Voilà comment se présente un code entre balises code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
patati
  patata
    repatati
  patata
patati
etc...

te semble-t-il vraiment que tel est l'aspect du tien ?

**MolikDLuffy** · 27/10/2017, 15h36

Monsieur Unparia,

Lorsque vous écrivez un message, vous avez accès à plusieurs balises qui permettent avec leur utilisation que les lecteurs apprécient mieux vos messages.

Pour la partie Balise Code, il suffit de cliquer sur la balise suivante :

Nom : balise code.jpg
Affichages : 123
Taille : 19,7 Ko

Nom : balise code.jpg
Affichages : 123
Taille : 19,7 Ko

[ CODE]
IL FAUT ECRIRE ENTRE
[/ CODE]

**Menhir** · 27/10/2017, 15h12

Je n'ai pas lu ton code, mais le plus simple est de l'appeler avec un Call dans une macro évènementielle Worksheet_Change.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Worksheet_Change(ByVal Target As Range)
    Call Combine()
End Sub

A adapter à ton cas.

Remplacer un bouton d'execution

Excel

Vue hybride

Discussions similaires

Partager

Partager