COPIE DE CLASSEUR ET ENVOIE PAR MAIL ATTACHÉ

'Ce code est créer par Birama Diop
' pour toute question vous pouver m'écrire un mail sur
'diopbirama@gmail.com

Private Sub cmdCopier_Click()
    If txtFeuilChoisi.Text <> "" Then
   Call CopierFeuilleExcel(getTemp & "test.xls")
  
   Else
   MsgBox ("Veuillez choisir la feuille a copier")
   End If
   If ((getTemp & "test.xls") = ActiveWorkbook.FullName) Then
   cmdCopier.Enabled = False
    cmdEnvoyer.Enabled = True
   Else
   cmdCopier.Enabled = True
   End If
End Sub

'Private classeurDeBase As Excel.Workbook
Private Sub cmdEnvoyer_Click()
ActiveWorkbook.SendMail Recipients:="diopbirama@gmail.com", _
                          Subject:="Test envoi classeur", _
                          ReturnReceipt:=True
                         ' URLto = "mailto:diopbirama@gmail.com" & "?subject=test d'envoi de fichier" & "&body=" & Msg
   ' ActiveWorkbook.FollowHyperlink Address:=URLto
End Sub

Private Sub cmdExit_Click()
 Unload Me
End Sub

Private Sub combFeuilleSource_Change()
    txtFeuilChoisi.Text = combFeuilleSource.Text
End Sub

'c'est ici que je récupere la liste des feuilles
'du classeur actif (Activeworkbooks)
Private Sub UserForm_Activate()
    Dim feuil As Object
    For Each feuil In ActiveWorkbook.Sheets
        combFeuilleSource.AddItem (feuil.Name)
    Next feuil
    'classeurDeBase = ActiveWorkbook
    If ((getTemp & "test.xls") = ActiveWorkbook.FullName) Then
   cmdCopier.Enabled = False
    cmdEnvoyer.Enabled = True
   Else
   cmdCopier.Enabled = True
   End If
    
End Sub

'cette procedure permet de copier la feuille choisie
'vers le classeur cible du dossier Temp
Private Sub CopierFeuilleExcel(ClasseurCible As String)
      Sheets(txtFeuilChoisi.Text).Copy
      Application.DisplayAlerts = False
      ActiveWorkbook.SaveAs (ClasseurCible)
      Application.DisplayAlerts = True
End Sub

'cette fonction permet de récuper le répertoire
'temporaire de windows
Function getTemp() As String
        Dim chemin As Object
    Dim DossierTemp As String
    Set chemin = CreateObject("Scripting.FileSystemObject")
    DossierTemp = chemin.GetSpecialFolder(TemporaryFolder).ShortPath
    getTemp = DossierTemp & "\Temp\"
End Function

Télécharger le zip