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
| Sub POINTAGE()
'déclaration des variables
Dim datejour As Variant
Dim nomjour As String
Dim NomFeuille As String
Dim FeuilleDépart As String
Dim TestFeuille As Worksheet
Dim Reponse As Byte 'numérique car un bouton = un numéro
'initialisation des variables
datejour = Date
'NomJour = ???
NomFeuille = nomjour & datejour
FeuilleDépart = ActiveSheet.Select
'on vérifie si la nouvelle feuille n'a pas déjà été créée dans le classeur
Application.DisplayAlerts = False 'désactive le message auto d'excel pour avertir d'une suppression
For Each TestFeuille In ActiveWorkbook.Sheets
If TestFeuille.Name = NomFeuille Then
Reponse = MsgBox("La feuille " & NomFeuille & " existe déjà." & Chr(10) _
& "Voulez-vous la remplacer ?", vbYesNo + vbCritical, "ERREUR")
If Reponse = vbYes Then 'si on clique sur Oui
TestFeuille.Delete
Exit For
Else
TestFeuille.Select
Exit Sub
End If
End If
Next
'création de la nouvelle feuille
ActiveSheet.Select
'ActiveSheet.Copy After:=Sheets(FeuilleDépart)
ActiveSheet.Copy After:=Sheets(1)
Range("A3").Select
ActiveCell.Value = nomjour
Range("B3").Select
'ActiveCell.Value = Date
ActiveCell.FormulaR1C1 = "=today()"
ActiveSheet.Name = NomFeuille
Range("B3").Select
End Sub |
Partager