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
| Sub copieretenvoimail()
'
' copieretenvoimail Macro
' copie de la feuille de semaine et envoi par mail
'
' enregistre une copie et envoi par mail
'déclaration des variables
Dim Initiale As String
Dim Semaine As String
Dim F As Worksheet
' f = Sheets(Semaine)
' message box pour demander les initiales
' inputbox pour initiale
' Initiale = InputBox("Saisissez vos initiale:", _
' "Le titre", "Sheets("Paramètres").Range("B2").Value.", 100, 400)
'Valeur des Initailes definit feuille Paramètres clellule B2
Initiale = Sheets("Paramètres").Range("B2").Value
' inputbox pour selection semaine
Semaine = InputBox("Saisissez la semaine :", _
"Le titre", "Donnée par défaut.", 100, 400)
' Vérification que la feuille semaine existe
On Error Resume Next
Set F = Sheets(Semaine)
On Error GoTo 0
' action a faire en fonction de l'existence de la feuille semaine
If F Is Nothing Then
MsgBox (Semaine & " n'existe pas")
Exit Sub
Else
Sheets(Semaine).Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Initiale & Semaine & ".xls"
Application.Dialogs(xlDialogSendMail).Show
' ActiveWorkbook.Name = Initiale & Semaine & ".xlsm"
' ActiveWorkbook.Close SaveChanges:=False
ActiveWorkbook.Close SaveChanges:=False
End If
'colorier onglet en vert lors de l'envoi
Sheets(Semaine).Select
With ActiveWorkbook.Sheets(Semaine).Tab
.Color = 6750054
.TintAndShade = 0
End With
'
End Sub |
Partager