luno123

Abd

XLDnaute Nouveau
Bonjour ,
En faisant des recherches je suis tombé sur un xls suivi des impayés de 2003.Ils se trouvent que les macro soont directement liés à un serveur, comment le lié un fichier excel et faire une extraction à partir d'un fichier.Je suis novice aider moi
 

Pièces jointes

  • Suivi relance 04-12.xlsx
    13 KB · Affichages: 15

Abd

XLDnaute Nouveau
A l'ouverture il ya aucune erreur , en revanche ce que je voudrais pouvoir modifier se trouve, sans l'onglet suivie impayé
1- mettre à jour 2-envoyer email aux chargés.. 3 envoyer email à la direction

Je voudrais pouvoir reconfigurer cela Vmax.
upload_2018-12-6_11-27-29.png
 

vmax01

XLDnaute Occasionnel
c'est toi qui as écrit ces codes ? énormément d'erreur et d’incohérence de date dans ton exemple.... facture après date d'echeance et le 30/02/2018 n'existe pas .... codes qui font référence a des feuilles qui n'existent pas...
 
Dernière édition:

vmax01

XLDnaute Occasionnel
bonjour, voila ton code terminé, tu met ça dans un module et tu n'auras plus qu' changer l'adresse de destination pour l'enregistrement des classeurs
Code:
Sub Envoi_Mail()
Dim OutApp As Object, OutMail As Object
Dim c, d, t, rng As Range, Debut$, Fin$
Dim R As String
Application.ScreenUpdating = False 'fige l'ecran
ActiveSheet.Shapes("Rectangle à coins arrondis 1").Visible = True 'retire le bouton commande
With Feuil7: Set d = .Range(.[D4], .[D65536].End(xlUp)) 'repere la matrice colonne D
ActiveSheet.Copy 'copie la feuille active
ActiveSheet.SaveAs ("C:\ ton chemin dossier impayés" & Format(Date, "dd-mm-yyyy") & ".xlsx") 'enregistre le nouveau classeur
R = "C:\ton chemin dossier impayés" & Format(Date, "dd-mm-yyyy") & ".xlsx" 'chemin du nouveau classeur pour lien par mail
For Each c In d 'boucle sur les adresse mail concernées
    Set OutApp = CreateObject("Outlook.Application") 'connexion outlook
    OutApp.Session.Logon 'ouvre la session mail
    Set OutMail = OutApp.CreateItem(0) 'creation du mail vide
    Debut = "Bonjour ," & Chr(13) & Chr(13) & "Ci-jointe la liste des impayés de la semaine avec les différentes actions à effectuer." & Chr(13) & Chr(13) & ""
    Fin = "Bonne réception" & Chr(13) & Chr(13) & "Cordialement" & Chr(13) & Chr(13) & "ADB" 'phrase du corps du mail
    On Error Resume Next
    With OutMail 'propriete du mail
      .To = c.Value 'adresse mail
      .Subject = "Relance du " & Format(Date, "dd-mm-yyyy") 'sujet
      .Body = Debut & Fin 'RangetoHTML'corps du mail
      '.Display  'Pour voir à l'écran
      .Attachments.Add R 'piece jointe
      .Send  'Pour envoyer directement
    End With
    On Error GoTo 0
    Set OutMail = Nothing 'vidage memoire du mail
    Set OutApp = Nothing 'vidage memoire du mail
Suite:
Next
End With
Application.ScreenUpdating = True 'reactivation de l'ecran
MsgBox ("envoie de mail avec succes")
End Sub

bonne continuation.
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 899
Membres
101 834
dernier inscrit
Jeremy06510