Copie de classeur et envoie par mail attaché

Télécharger le projet
Commenter

Description

Il est souvent difficile d'envoyer par mail la feuille actif dans excel ce code a pour de palier a ce problème.
Il copie la feuille et seulement la feuille qu'on veut envoyer par mail sur un classeur temporaire et envoie ce dernier via outlook ou windows live Mail .

Source / Exemple : 


'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

Conclusion :


Si vous voulez l'envoie avec lotus vous pouvez me contacter.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_bir)