begin process at 2010 03 20 05:13:43
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

VBA

 > COPIE DE CLASSEUR ET ENVOIE PAR MAIL ATTACHÉ

COPIE DE CLASSEUR ET ENVOIE PAR MAIL ATTACHÉ


 Description

Cliquez pour voir la capture en taille normale
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

  • '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
'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.

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources de la même categorie

LIEN HYPERTEXTE SOUS EXCEL EN PARTAGE par LMJ
Source avec Zip OUTIL DE FORMATION par l0r3nz1
Source avec Zip Source avec une capture UN PHOTO RESIZEUR par patosch
CONVERSION D'UN NOMBRE EN "PACKED NUMBER", ET INVERSEMENT par WebSeb
COPIER LES TEXTES D'UNE DIAPOSITIVE POWERPOINT SAUF LES ESPA... par GMY

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture Source .NET (Dotnet) ENVOI DES E-MAIL VIA VB.NET 2005 par naimovech
Source avec Zip Source avec une capture Source .NET (Dotnet) ENVOI D'EMAIL AVEC DES API WINDOWS VIA UNE INTERFACE GRAPHIQ... par Belouafi
Source avec Zip ENVOI AUTOMATIQUE DE MAIL (AVEC PIÈCE JOINTE) EN VBA : EXCEL... par nerim
ENVOI DE MAIL SIMPLE AVEC LOTUS NOTES - VB par Drouzig

Commentaires et avis

Commentaire de ludot76 le 09/12/2009 16:31:37

Bonjour, est il possible d'envoyer par cette macro à plusieurs adresse mail
dans une cellule ou les adresses seraient regroupées par une formule concatener
et si l'envoie peut etre fais en copie caché

Merci d'avance
Pour votre aide

 Ajouter un commentaire




Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Mars 2010
LMMJVSD
1234567
891011121314
15161718192021
22232425262728
293031    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,608 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales