begin process at 2008 09 05 07:20:41
1 237 085 membres
52 nouveaux aujourd'hui
14 312 membres club

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

COPIE DE CLASSEUR ET ENVOIE PAR MAIL ATTACHÉ


Information sur la source

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

  • '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.
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

    Aucun commentaire pour le moment.

Ajouter un commentaire

Pub



Appels d'offres

Recherche developpeur ...
Budget : 700€
SITE MARCHAND LOCATION...
Budget : 3 000€
SITE MARCHAND POUR HOTEL
Budget : 4 000€

CalendriCode

Septembre 2008
LMMJVSD
1234567
891011121314
15161718192021
22232425262728
2930     

Téléchargements

Boutique

Boutique de goodies CodeS-SourceS