Email avec fichier protegé

Bonjour

j'ai une macro qui fonctionne merveilleusement bien,

cette macro envoie une partie bien définie d'une feuille d'un classeur par EMAIL via Gmail.

pour cela c'est excellent

j'aimerais pourvoir intégrer le verrouillage de la feuille, comme cela celui qui reçois le émail ne pourras modifier la feuille ( du-moins son contenue)

merci pour toute l'aide

Option Explicit
Public Sub CDO_Mail1_ActiveSheet()
Dim wbSource As Workbook, wbNew As Workbook
Dim FileExtStr As String, TempFilePath As String, TempFileName As String
Dim FileFormatNum As Long
Dim iMsg As Object, iConf As Object
Dim Flds As Variant
Dim signature As String
'EMAIL recap jour

If MsgBox("Etes-vous certain de vouloir envoyer cette email ?", vbQuestion + vbYesNo, _
            "Demande de confirmation") <> vbYes Then Exit Sub

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wbSource = ActiveWorkbook
    ' Copie la feuille active dans un nouveau classeur.

   ActiveSheet.Copy

    ActiveSheet.Range("A1:A20") = wbSource.Sheets("RECAPMOIS").Range("A1:A20").Value
    ActiveSheet.Range("B1:B20") = wbSource.Sheets("RECAPMOIS").Range("B1:B20").Value
    ActiveSheet.Range("C1:C20") = wbSource.Sheets("RECAPMOIS").Range("C1:C20").Value
    ActiveSheet.Range("D1:D20") = wbSource.Sheets("RECAPMOIS").Range("D1:D20").Value
    ActiveSheet.Range("E1:E20") = wbSource.Sheets("RECAPMOIS").Range("E1:E20").Value
    ActiveSheet.Range("F1:F20") = wbSource.Sheets("RECAPMOIS").Range("F1:F20").Value
    ActiveSheet.Range("G1:G20") = wbSource.Sheets("RECAPMOIS").Range("G1:G20").Value
    ActiveSheet.Range("H1:H20") = wbSource.Sheets("RECAPMOIS").Range("H1:H20").Value
    ActiveSheet.Range("I1:I20") = wbSource.Sheets("RECAPMOIS").Range("I1:I20").Value
    ActiveSheet.Range("J1:J20") = wbSource.Sheets("RECAPMOIS").Range("J1:J20").Value
    ActiveSheet.Range("K1:K20") = wbSource.Sheets("RECAPMOIS").Range("K1:K20").Value
    ActiveSheet.Range("L1:L20") = wbSource.Sheets("RECAPMOIS").Range("L1:L20").Value
    ActiveSheet.Range("M1:M20") = wbSource.Sheets("RECAPMOIS").Range("M1:M20").Value
    ActiveSheet.Range("N1:M20") = wbSource.Sheets("RECAPMOIS").Range("N1:M20").Value

    ' Ou si vous voulez copier plusieurs feuilles. Utilisez :
   ' wbSource.Sheets(Array("Sheet1", "Sheet3")).Copy

   ActiveSheet.Shapes.Range(Array("bouton1")).Select 'Efface le bouton d'envoie
    Selection.Delete

   Set wbNew = ActiveWorkbook
    ' On détermine la version Excel et l'extension du fichier / Format
   With wbNew
        If Val(Application.Version) < 12 Then
            ' Excel 97-2003
           FileExtStr = ".xls": FileFormatNum = -4143
        Else
            ' 2007-2010
           ' On sort de la procédure dans le cas les macros sont désactivées.
           ' *** cas ou cette procédure est lancée d'un autre classeur (ex : Personal.xlsb).***
           If wbSource.Name = .Name Then
                Application.EnableEvents = True
                MsgBox "Vous n'avez pas activé les macros."
                Exit Sub
            Else
                Select Case wbSource.FileFormat
                    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                    Case 52:
                        If .HasVBProject Then
                            FileExtStr = ".xlsm": FileFormatNum = 52
                        Else
                            FileExtStr = ".xlsx": FileFormatNum = 51
                        End If
                    Case 56: FileExtStr = ".xls": FileFormatNum = 56
                    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
    ' Sauve le nouveau classeur, poste le message et supprime le fichier temporaire crée.
   TempFilePath = Environ$("temp") & "\"
    TempFileName = "Recap Jour " & wbSource.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    With wbNew
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        MsgBox TempFilePath & TempFileName & FileExtStr
        .Close savechanges:=False
    End With

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1    ' Source par défaut CDO
   Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "" ' email
       .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "" ' mot de pass
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" ' c-renaultdz2.hdispo.com
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Update
    End With

    With iMsg
        Set .Configuration = iConf

        signature = "Mr HEDRACHE Salim" & vbCrLf & "Chef Atelier" 'changer votre nom entre les " "

        .To = "tlemcen@renault.dz" ' a qui on envoie
        .CC = "compta.tlemcen@renault.dz, ca.tlemcen@renault.dz" ' pour qui la copie
        .BCC = "" ' copie conforme

        '.To = "" ' a qui on envoie
        '.CC = "" ' pour qui la copie
        '.BCC = "" ' copie conforme

        .From = "ca.tlemcen@renault.dz" ' de
       .Subject = "La Recap du Mois" ' à modifier
       .TextBody = "Bonjour," & vbCrLf & "je vous pris de bien vouloir recevoir le mail de la recap du mois," & vbCrLf & "cordialement" & vbCrLf & signature 'à modifier
       .AddAttachment TempFilePath & TempFileName & FileExtStr
        .Send
    End With

   'Range("R5:R11").Select
   ' With Selection.Interior
    '    .Pattern = xlSolid
     '   .PatternColorIndex = xlAutomatic
     '   .Color = 65280
     '   .TintAndShade = 0
     '   .PatternTintAndShade = 0
   ' End With

    'Supprime le fichier envoyé.
   Kill TempFilePath & TempFileName & FileExtStr

    Application.EnableEvents = True

    Set Flds = Nothing
    Set iConf = Nothing
    Set iMsg = Nothing
    Set wbNew = Nothing: Set wbSource = Nothing

End Sub