Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Byte
Dim NomFichier$
If Target = Cells(1, 2) Then
r = MsgBox("Voulez vous lancer l'effacement ?", vbYesNo, "Effacement ?")
If r = 6 Then
Cells(2, 2).ClearContents
Range(Cells(9, 8), Cells(48, 11)).ClearContents
Range(Cells(9, 21), Cells(48, 21)).ClearContents
End If
NomFichier = "Fichier" & Target.Value & ".xls"
r = MsgBox("Voulez vous enregister le classeur sous le nom :" & NomFichier, vbYesNo, "Effacement ?")
If r = 6 Then ActiveWorkbook.SaveAs (NomFichier)
End If
End Sub
Union(Cells(2, 2), Range(Cells(9, 8), Cells(48, 11)), _
Range(Cells(9, 21), Cells(48, 21))).ClearContents
Sub Essaie_I()
Range("A1:F20").Formula = "=ROW()*COLUMN()"
m = MsgBox("Effacement Méthode I, Cliquez sur OK")
If m = 1 Then
Range("A1:B3,C6:D8,E10:F12").ClearContents
End If
End Sub
Sub Essaie_II()
Range("A1:F20").Formula = "=ROW()*COLUMN()"
m = MsgBox("Effacement Méthode II, Cliquez sur OK")
If m = 1 Then
Union(Range(Cells(1, 1), Cells(3, 2)), _
Range(Cells(6, 3), Cells(8, 4)), _
Range(Cells(10, 5), Cells(12, 6))).ClearContents
End If
End Sub
If Not Intersect(Target, Cells(1, 2)) Is Nothing Then
à la place de
If Target = Cells(1, 2) Then
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Byte
Dim NomFichier$
If Not Intersect(Target, Cells(1, 2)) Is Nothing Then
r = MsgBox("Voulez vous lancer l'effacement ?", vbYesNo, "Effacement ?")
If r = 6 Then Union(Cells(2, 2), Range(Cells(9, 8), Cells(48, 11)), Range(Cells(9, 21), Cells(48, 21)), Cells(49, 11)).ClearContents
NomFichier = "Fichier" & Target.Value & ".xls"
r = MsgBox("Voulez vous enregister le classeur sous le nom :" & NomFichier, vbYesNo, "Effacement ?")
If r = 6 Then ActiveWorkbook.SaveAs (NomFichier)
End If
End Sub
Enfin, serait il possible que si on répond non la la procèdure d'effacement, la procèdure d'enregistrement se ne lance pas
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Byte
Dim NomFichier$
If Not Intersect(Target, Cells(1, 2)) Is Nothing Then
r = MsgBox("Voulez vous lancer l'effacement ?", vbYesNo, "Effacement ?")
If r = 6 Then
Union(Cells(2, 2), Range(Cells(9, 8), Cells(48, 11)), Range(Cells(9, 21), Cells(48, 21)), Cells(49, 11)).ClearContents
NomFichier = "Fichier" & Target.Value & ".xls"
r = MsgBox("Voulez vous enregister le classeur sous le nom :" & NomFichier, vbYesNo, "Effacement ?")
If r = 6 Then ActiveWorkbook.SaveAs (NomFichier)
[Color=blue]End If[/color]
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Byte
Dim NomFichier$
If Not Intersect(Target, Cells(1, 2)) Is Nothing Then
r = MsgBox("Voulez vous lancer l'effacement ?", vbYesNo, "Effacement ?")
If r = 6 Then
Union(Cells(2, 2), Range(Cells(9, 8), Cells(48, 11)), Range(Cells(9, 21), Cells(48, 21)), Cells(49, 11)).ClearContents
If IsDate(Cells(1, 2)) Then
[color=red]NomFichier = Format(CDate(Cells(1, 2)), "mmmm") & " - " & CStr(Year(Cells(1, 2))) & ".xls"[/color]
Else: Exit Sub
End If
r = MsgBox("Voulez vous enregister le classeur sous le nom : " & NomFichier, vbYesNo, "Effacement ?")
If r = 6 Then ActiveWorkbook.SaveAs (NomFichier)
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'------- Macro 1 :
Msgbox "Je suis la macro n°1"
'--------macro 2 :
Dim r As Byte
Dim NomFichier$
If Not Intersect(Target, Cells(1, 2)) Is Nothing Then
r = MsgBox("Voulez vous lancer l'effacement ?", vbYesNo, "Effacement ?")
If r = 6 Then
Union(Cells(2, 2), Range(Cells(9, 8), Cells(48, 11)), Range(Cells(9, 21), Cells(48, 21)), Cells(49, 11)).ClearContents
If IsDate(Cells(1, 2)) Then
NomFichier = Format(CDate(Cells(1, 2)), "mmmm") & " - " & CStr(Year(Cells(1, 2))) & ".xls"
Else: Exit Sub
End If
r = MsgBox("Voulez vous enregister le classeur sous le nom : " & NomFichier, vbYesNo, "Effacement ?")
If r = 6 Then ActiveWorkbook.SaveAs (NomFichier)
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Macro1
Macro2
End Sub
Autre option : copier les 2 macros dans un module en leur donnant un nom particulier (Macro1 et Macro2). Puis dans insérer ces 2 noms dans ta macro Worksheet_Change :
NomFichier = [color=red]"C:\MesDocuments\FichierAuto\" & [/color] Format(CDate(Cells(1, 2)), "mmmm") & " - " & CStr(Year(Cells(1, 2))) & ".xls"
Private Sub CommandButton1_Click()
Macro1
End Sub
Private Sub CommandButton1_Click()
Dim r As Byte
Dim NomFichier$
If Not Intersect(Target, Cells(1, 2)) Is Nothing Then
r = MsgBox("Voulez vous lancer l'effacement ?", vbYesNo, "Effacement ?")
If r = 6 Then
Union(Cells(2, 2), Range(Cells(9, 8), Cells(48, 11)), Range(Cells(9, 21), Cells(48, 21)), Cells(49, 11)).ClearContents
If IsDate(Cells(1, 2)) Then
NomFichier = [color=red]"C:\MesDocuments\FichierAuto\" & [/color] Format(CDate(Cells(1, 2)), "mmmm") & " - " & CStr(Year(Cells(1, 2))) & ".xls"
Else: Exit Sub
End If
r = MsgBox("Voulez vous enregister le classeur sous le nom : " & NomFichier, vbYesNo, "Effacement ?")
If r = 6 Then ActiveWorkbook.SaveAs (NomFichier)
End If
End If
End Sub