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 ?

**ancien1957** · 27/10/2017, 13h58

Que dois-je faire pour qu'il ait cet aspect ?

**parmi** · 27/10/2017, 14h32

Sélectionne ton code et presse le bouton #

Et quand il s'agit de macros, poste dans le forum dédié aux macros...

**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.

**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]

**ancien1957** · 27/10/2017, 19h11

J'ai un petit soucis, quand j'efface une cellule parmi la plage K1:K500 , la procédure se répète dans une autre feuille.

Code :

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

1
2
3
4
5
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("K1:K500")) Is Nothing Then
Call Combine
Calle Macro4
Call Macro6

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
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

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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]

[/CODE]
et voici mon code Macro6 :
[CODESub Macro6()

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
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

**clementmarcotte** · 27/10/2017, 21h18

Envoyé par MolikDLuffy

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.

Monsieur unparia le sait très bien

**parmi** · 27/10/2017, 22h08

L'événement Change survient lors d'un changement sur la feuille.
Si tu refais un changement sur cette même feuille dans ta ou tes macros, l'événement va être rappelé en boucle sans arrêter.

C'est difficile de voir parce qu'on ne sait pas trop d'où démarre l'événement Change et où sont faits les changements des macros.

**Menhir** · 30/10/2017, 08h42

Envoyé par ancien1957

J'ai un petit soucis, quand j'efface une cellule parmi la plage K1:K500 , la procédure se répète dans une autre feuille.

Où as-tu placé ta macro Worksheet_Change ?

**ancien1957** · 30/10/2017, 15h35

J'ai placé ma macro dans un module.

**parmi** · 30/10/2017, 16h23

Évite les Selection
Le code suivant

Code :

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

1
2
3
4
5
6
7
8
Range("A1").Select
ActiveCell.FormulaR1C1 = "Noms"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Classe"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Moyenne"
Columns("B").Select
With Selection

se remplace facilement par

Code :

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

1
2
3
4
5
Range("A1") = "Noms"
Range("B1") = "Classe"
Range("C1") = "Moyenne"
With Columns("B")
....

Et spécifie le nom des feuilles (et du classeur si nécessaire)

Code :

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

1
2
3
4
5
6
With Sheets("MaFeuille")  'à changer au besoin
   .Range("A1") = "Noms"
   .Range("B1") = "Classe"
   .Range("C1") = "Moyenne"
   With .Columns("B")
   ...................

Remplacer un bouton d'execution

Excel

Discussions similaires

Partager

Partager