Enregistrement en zip sous nom de cellule

Bonjour à tous et merci pour votre site.

Je suis débutant dans le maniement des macros sur Excel, et je reste bloqué sur un petit souci.
J’utilise actuellement cette macro :

Public Sub action()
Imprarticle
ImprDEVIS
CALCUL
envoyer
End Sub

Public Sub Imprarticle()
Sheets('Creation article').Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets('DEVIS').Select
End Sub
Public Sub ImprDEVIS()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub
Public Sub CALCUL()
Dim Chr As String 'déclare la variable
Chr = Range('DEVIS!K7') 'FEUILLE DEVIS CELLULE K7
ChDrive 'C' 'si C n'est pas le disque par défaut
ChDir 'C:\\DEVIS\\'
ActiveWorkbook.SaveAs Filename:=(Chr)
End Sub
Public Sub envoyer()
ActiveWorkbook.SendMail Recipients:=Array(''), Subject:='Message de Chris '
End Sub

Je souhaiterais ajouter à cette macro, une action zip, qui compresserait automatiquement le fichier enregistrer d’après ma cellule, après compression supprimer le fichier .xls pour ne garder que mon classeur zippé dans mon dossier « devis »,l’envoyer par mail, enfin garder ouvert mon classeur d’ouverture.
Je sais que je demande un peut la Lune, mais je suis sur le problème depuis plusieurs jours c’est pourquoi je me tourne vers les experts…
Merci par avance de vos éclaircissements.