Macro création feuille de calcul + formatage corps mail envoyé par macro

Le 21/01/2024 à 16:53

Bonjour,

Je suis TRES novice en macro et en bidouillant un peu, j'ai réussi à faire ce que je voulais. Mais le résultat n'est pas optimum pour ma première macro ni super esthétique pour la seconde... d'où mon appel à l'aide.

Description du fichier et de son utilisation :

Le fichier me sert à gérer les absences en formation de mes stagiaires.
J'ai une première feuille appelée "Liste des Stagiaires" dans laquelle je rentre en ligne un certain nombre d'informations à propos de chaque stagiaire (Nom, Prénom, Formation, Date de début Formation, Date de fin formation...) : 1 ligne = 1 stagiaire, 1 colonne = 1 info le concernant.
Pour chaque nouveau stagiaire saisi, une première macro me permet de générer la fiche de suivi de l'assiduité du stagiaire dans une nouvelle feuille de calcul qui porte le nom du stagiaire, selon un modèle prédéfini qui comporte :
- un entête récapitulant les informations administratives du stagiaires et les coordonnées des personnes à qui je dois envoyer un mail en cas d'absence / retard,
- une ligne pour chaque date allant du début de la formation à la fin de la formation (le remplissage se fait en excluant les week-ends et les jours de fermeture du centre, définis dans une liste séparée).

Quand un stagiaire est absent, ou en retard ou part avant la fin du cours pour une journée donnée, je saisis les infos sur la ligne correspondant à la journée concernée. Chaque jour ou semaine, la seconde macro me permet d'envoyer un mail récapitulatif au contact dont les coordonnées figurent sur la feuille de suivi d'assiduité, avec le stagiaire et la coordonnatrice de l'action en CC.

Première macro

J'ai visé "très large" pour le nombre de lignes, pour être sûre d'en avoir assez, mais certaines formations peuvent être :

- bien plus courtes donc, plein de lignes vides à supprimer,

- je n'exclus pas que certaines durent plus longtemps (ce qui obligerait à rajouter des lignes "à la main").

Comment puis-je optimiser mon code (ou mon modèle ?) pour n'avoir QUE le bon nombre de lignes ? (1 date par jour de formation (du lundi au vendredi), entre les dates de début et de fin de formation, en excluant les jours de fermeture) ?

Sub CréationFeuilleStagiaire()

    Dim NbFeuille As Double
    Dim MonNomStagiaire As String

    MonNomStagiaire = ActiveCell
    Sheets("Modèle stagiaire").Visible = True
    NbFeuille = ThisWorkbook.Worksheets.Count
    Sheets("Modèle stagiaire").Copy After:=Sheets(NbFeuille)
    Sheets(NbFeuille + 1).Name = MonNomStagiaire
    Sheets(MonNomStagiaire).Cells(1, 2).Value = MonNomStagiaire
    Sheets(MonNomStagiaire).Visible = True
    Sheets("Modèle stagiaire").Visible = False

End Sub

Seconde Macro

C'est celle qui envoie le mail.

Elle fait bien ce que je veux à savoir => quand il y a des heures d'absence ET que la colonne G est vide, ou quand il y a retard ET que la colonne G est vide ou quand il y a départ anticipé ET que la colonne G est vide, le bouton envoyer un mail :
- fait partir un mail qui récapitule les éléments relatifs aux absences / retard / départ avec en destinataire l'adresse de la cellule A6, en CC les cellules B2 et E6,
- ajoute la date du jour d'envoi dans la colonne G

Mon problème est que le mail est super "moche" et j'ai essayé de le formater en utilisant des balises HTML mais sans succès. J'aurais aimé par exemple que la police du mail soit calibri, que le fond de l'entête du tableau soit bleu et le texte en gras et idem pour la ligne qui récapitule le total. De même j'aimerais que certains éléments du corps du texte soient en gras (le nom du stagiaire par exemple).

Sub EnvoiMailTuteur()
    Dim MesInvités(40) As String
    Dim MonObjet As String
    Dim MonCorps As String

    MonObjet = Range("MailObjet").Value

    MonCorps = "<!DOCTYPE html><body>" & Range("MailPhrase1").Value & "<p>"
    MonCorps = MonCorps & Range("MailPhrase2").Value & ActiveSheet.Cells(1, 2) & ", "
    MonCorps = MonCorps & ActiveSheet.Cells(1, 16) & ", "
    MonCorps = MonCorps & Range("MailPhrase3").Value & ActiveSheet.Cells(1, 6) & " "
    MonCorps = MonCorps & Range("MailPhrase4").Value & ":<p>"

    'Début du tableau des absences
    MonCorps = MonCorps & "<table border>"
    MonCorps = MonCorps & "<tr> <th> Date </th> <th> H.Planifiées </th> <th> Période absence </th><th> H.Absence </th><th>Cumul Retards (hh:mm)</th><th>Cumul Départs anticipés (hh:mm)</th><th>A prévenu ?</th><th>Justificatif</th></tr>"

    For i = 12 To 500
        If ActiveSheet.Cells(i, 5).Value > 0 And IsEmpty(ActiveSheet.Cells(i, 17)) And Not IsEmpty(ActiveSheet.Cells(i, 1)) Then
            ActiveSheet.Cells(i, 17).Value = Date
            MonCorps = MonCorps & "<tr> <td align=""center"">" & Format(ActiveSheet.Cells(i, 2).Value, "dd/mm/yyyy") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 3).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 6).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 5).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 9).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 12).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 13) & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 14) & "</td></tr>"
        ElseIf ActiveSheet.Cells(i, 9).Value > 0 And IsEmpty(ActiveSheet.Cells(i, 17)) And Not IsEmpty(ActiveSheet.Cells(i, 1)) Then
            ActiveSheet.Cells(i, 17).Value = Date
            MonCorps = MonCorps & "<tr> <td align=""center"">" & Format(ActiveSheet.Cells(i, 2).Value, "dd/mm/yyyy") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 3).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 6).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 5).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 9).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 12).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 13) & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 14) & "</td></tr>"
        ElseIf ActiveSheet.Cells(i, 12).Value > 0 And IsEmpty(ActiveSheet.Cells(i, 17)) And Not IsEmpty(ActiveSheet.Cells(i, 1)) Then
            ActiveSheet.Cells(i, 17).Value = Date
            MonCorps = MonCorps & "<tr> <td align=""center"">" & Format(ActiveSheet.Cells(i, 2).Value, "dd/mm/yyyy") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 3).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 6).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 5).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 9).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 12).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 13) & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 14) & "</td></tr>"
        End If
    Next
    'Fin du tableau des absences
    MonCorps = MonCorps & "<TR background-color=""blue""> <td align=""center"">" & "CUMUL DEPUIS LE " & Format(ActiveSheet.Cells(2, 6).Value, "dd/mm/yyyy") & "</td>"
    MonCorps = MonCorps & "<td align=""center"">" & " </td>"
    MonCorps = MonCorps & "<td align=""center"">" & "  </td>"
    MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(10, 5) & "</td>"
    MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(10, 9).Value, "hh:mm") & "</td>"
    MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(10, 12).Value, "hh:mm") & "</td>"
    MonCorps = MonCorps & "<td align=""center"">" & "  </td>"
    MonCorps = MonCorps & "<td align=""center"">" & "  </td></tr>"
    MonCorps = MonCorps & "</table>"
    MonCorps = MonCorps & Range("MailPhrase5").Value & "</br>"
    'Début du tableau des horaires
    MonCorps = MonCorps & "<table border>"
    MonCorps = MonCorps & "<tr> <th>  </th> <th> Début des cours</th> <th> Fin des cours</th></tr>"
    MonCorps = MonCorps & "<TR> <td align=""center"">" & ActiveSheet.Cells(3, 10) & "</td>"
    MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(3, 11).Value, "hh:mm") & "</td>"
    MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(3, 12) & "</td></TR>"
    MonCorps = MonCorps & "<TR> <td align=""center"">" & ActiveSheet.Cells(4, 10) & "</td>"
    MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(4, 11) & "</td>"
    MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(4, 12).Value, "hh:mm") & "</td></TR>"
    'Fin du tableau des horaires
    MonCorps = MonCorps & "</table>"
    MonCorps = MonCorps & Range("MailPhrase6").Value & "<p>"
    MonCorps = MonCorps & Range("MailPhrase7").Value & ActiveSheet.Cells(1, 2) & ".<p>"
    MonCorps = MonCorps & Range("MailPhrase8").Value & "</FONT>" & "<br>"
    MonCorps = MonCorps & "<FONT color=""blue"">" & Range("MailPhrase9").Value & "</FONT><br>"
    MonCorps = MonCorps & Range("MailPhrase10").Value & "<br>"
    MonCorps = MonCorps & Range("MailPhrase11").Value & "<br>"
    MonCorps = MonCorps & Range("MailPhrase12").Value & "<br>"
    MonCorps = MonCorps & Range("MailPhrase13").Value & "<br>"
    MonCorps = MonCorps & "<FONT color=""steelblue"">" & Range("MailPhrase14").Value & "</FONT>"

    MonCorps = MonCorps & "</body><HTML>"

    Call MonEnvoiMail(ActiveSheet.Cells(6, 1).Value, ActiveSheet.Cells(2, 2).Value & ";" & ActiveSheet.Cells(6, 5).Value, "", MonObjet, MonCorps, False)
End Sub
Sub MonEnvoiMail(ByVal MesDestinataires As String, ByVal MesDestinatairesCopie As String, _
                ByVal MesDestinatairesCopieCachée As Variant, ByVal MonObjet As String, _
                ByVal MonCorps As String, ByVal MonChoixPièceAttachée As Boolean)

Dim i As Integer
Dim MaMessagerie As Object
Dim MonMail As Object
Dim MaSignature As String

    Set MaMessagerie = CreateObject("Outlook.Application")
    If Not (MaMessagerie Is Nothing) Then
        Set MonMail = MaMessagerie.CreateItem(0)
        With MonMail
            .BCC = MesDestinatairesCopieCachée
            .CC = MesDestinatairesCopie
            .Subject = MonObjet
            .BodyFormat = 2
            .HTMLBody = MonCorps
            .To = MesDestinataires
            .Display
        End With
      Set MonMail = Nothing
      Set MaMessagerie = Nothing
   End If

End Sub

Un immense merci d'avance de vos retours !!

Le 21/01/2024 à 21:35

bonjour

hoh purée j'ai mis plus d'une heure a trouver et comprendre
non c'est tout simplement pas possible
on ne travaille pas le html comme ça en string
purré j'en ai encore les larmes de douleur

je t'ai fait ça tu changera les couleur comme tu souhaite

Option Explicit
Sub EnvoiMailTuteur()
    Dim MesInvités(40) As String
    Dim MonObjet$, MonCorps$, a, HtmlDOC As Object, table, table2, trs, Text1, I&, TH, TD, EleM

    a = Array("Date", "Heures<br>Planifiées", "Période<br>absence", "H.Absence", "Cumul Retards<br>hh:mm)", "Cumul Départs anticipés (hh:mm)", "A prévenu", "Justificatif")

    Text1 = Range("MailPhrase1").Value & "<p>" & Range("MailPhrase2").Value & "<FONT COLOR=BLUE><b>" & ActiveSheet.Cells(1, 2) & "</b></font>, " & ActiveSheet.Cells(1, 16) & ", " & _
            Range("MailPhrase3").Value & ActiveSheet.Cells(1, 6) & " " & Range("MailPhrase4").Value & ":<p>"

    MonObjet = Range("MailObjet").Value
    Set HtmlDOC = CreateObject("htmlfile")
    With HtmlDOC
        .body.innerhtml = Text1 & "<table><tr></tr><tr></tr></table>"    'une table html avec 2 ligne vides

        With .getelementsbytagname("table")(0)
            .Style.Fontfamily = "calibri" ' font name pour toute la table  et ses descendants
            .Style.bordercollapse = "collapse" 'bordures collées
        End With

        Set trs = .getelementsbytagname("TR")
        For I = 0 To UBound(a)
            Set TH = trs(0).appendchild(.createelement("th")): TH.innerhtml = a(I)    ' création des entêtes de la table html
            TH.Style.Border = "2.5pt solid rgb(255,200,0)"  ' bordure entêtes (dim , style du trait , couleur)
            TH.Style.backgroundcolor = "rgb(0,200,50)"      'interior cellule entêtes
            TH.Style.Width = "100pt"                        'largeur cellule
            TH.Style.Color = "black"                        'couleur du texte

            Set TD = trs(1).appendchild(.createelement("td"))
            TD.Style.Border = "0.5pt solid black"           'idem
            TD.Style.Height = "25pt"                        'hauteur de cellules html
            TD.Style.TextAlign = "center"                   'alignement du text
            TD.Style.backgroundcolor = "rgb(220,22,50)"     'interior color des cellules html
            TD.Style.Color = "white"                        'couleur du texte
        Next

        'Fin du tableau des absences
        trs(1).ChildNodes(0).innerhtml = "CUMUL DEPUIS LE<br>" & Format(ActiveSheet.Cells(2, 6).Value, "dd/mm/yyyy") & "</td>"
        'trs(1).ChildNodes(1).innerhtml = ""
        'trs(1).ChildNodes(2).innerhtml = ""
        trs(1).ChildNodes(3).innerhtml = ActiveSheet.Cells(10, 5)
        trs(1).ChildNodes(4).innerhtml = Format(ActiveSheet.Cells(10, 9).Value, "hh:mm") & "</td>"
        trs(1).ChildNodes(5).innerhtml = Format(ActiveSheet.Cells(10, 12).Value, "hh:mm") & "</td>"
        trs(1).ChildNodes(6).innerhtml = ""
        trs(1).ChildNodes(7).innerhtml = ""

        HtmlDOC.body.innerhtml = HtmlDOC.body.innerhtml & "<br>" & Range("MailPhrase5").Value

        'Début du tableau des horaires(création)
        .body.innerhtml = .body.innerhtml & "<table>" & _
                          "<tr><th></th><th></th><th></th></tr>" & _
                          "<tr><td></td><td></td><td></td></tr>" & _
                          "<tr><td></td><td></td><td></td></tr></table>"

        Set table2 = .getelementsbytagname("table")(1)    'on la pointe en tant qu'object

        With table2    'on va la styler
            .Style.bordercollapse = "collapse"    'bordure collées
            .Style.TextAlign = "center"    'texte aligné au centre
            .Style.Fontfamily = "calibri"    ' le font name pour toute la table et ses descendants
        End With

        Set trs = table2.getelementsbytagname("TR")
        trs(0).ChildNodes(1).innerhtml = "Début des cours"
        trs(0).ChildNodes(2).innerhtml = "Fin des cours"
        trs(1).ChildNodes(0).innerhtml = "MATIN"
        trs(2).ChildNodes(0).innerhtml = "A M"
        trs(1).ChildNodes(1).innerhtml = ActiveSheet.Cells(3, "k").Text
        trs(2).ChildNodes(1).innerhtml = ActiveSheet.Cells(4, "k").Text
        trs(1).ChildNodes(2).innerhtml = ActiveSheet.Cells(3, "l").Text
        trs(2).ChildNodes(2).innerhtml = ActiveSheet.Cells(4, "l").Text

        'un peu de style maintenant pour les cellules html
        For Each EleM In table2.all
            With EleM
                Select Case EleM.tagname
                Case "TH"    ' les cellules entêtes html
                    .Style.Border = "1pt solid black"           'bordure 1 point d'epaisseur trait plein noir
                    .Style.backgroundcolor = "rgb(0,50,220)"    'interior de l'entête du tableau html
                    .Style.Color = "yellow"                     'couleur du texte
                    .Style.Fontfamily = "calibri"               'font name du texte
                    .Style.Width = "100pt"                      'largeur des cellule
                Case "TD"    'les cellules html
                    .Style.Border = "1pt solid black"           'idem
                    .Style.Color = "red"
                    .Style.backgroundcolor = "rgb(0,255,255)"
                End Select

            End With
        Next

        .body.innerhtml = .body.innerhtml & "</br>" & Range("MailPhrase6").Value & "<p>" & _
                          Range("MailPhrase7").Value & ActiveSheet.Cells(1, 2) & ".<p>" & _
                          Range("MailPhrase8").Value & "</FONT>" & "<br>" & _
                          "<FONT color=""blue"">" & Range("MailPhrase9").Value & "</FONT><br>" & _
                          Range("MailPhrase10").Value & "<br>" & _
                          Range("MailPhrase11").Value & "<br>" & _
                          Range("MailPhrase12").Value & "<br>" & _
                          Range("MailPhrase13").Value & "<br>" & _
                          "<FONT color=""steelblue"">" & Range("MailPhrase14").Value & "</FONT>"
    End With
    MonCorps = HtmlDOC.body.innerhtml
    Call MonEnvoiMail(ActiveSheet.Cells(6, 1).Value, ActiveSheet.Cells(2, 2).Value & ";" & ActiveSheet.Cells(6, 5).Value, "", MonObjet, MonCorps, False)
End Sub
Le 22/01/2024 à 18:47

Bonsoir Patrick,

Merci beaucoup d'avoir pris le temps de me répondre !! Désolée pour les larmes de douleur... Je me suis basée sur un code récupéré sur le net, comme quoi, on trouve à boire et à manger et comme j'avais réussi à faire fonctionner, ma foi :)

J'ai remplacé par le code que tu m'as donné et quand je lance la macro, j'ai ce message d'erreur :

capture d ecran 2024 01 22 184124

Je suis malheureusement incapable de voir où se situe le problème.

Le 22/01/2024 à 19:08

re

remplace tout les mot ChildNodes par Children peut être que tes librairie html sont tellement tronqué car je suppose que tu travaille sur W 11 et off 365

pour info vola ce que ca donne chez moi

Le 22/01/2024 à 20:58

Je ne peux pas voir que ce ça donne chez toi, le fichier a été retiré avant que je puisse y accéder.

Néanmoins, en remplaçant les Childnodes par Children, le mail se génère bien (W11 et Off 2023, j'aurais sans doute du préciser, en effet), youpi !

Je vais essayer de modifier cette partie de mon code qui faisait pleurer les yeux :

 For i = 12 To 500
        If ActiveSheet.Cells(i, 5).Value > 0 And IsEmpty(ActiveSheet.Cells(i, 17)) And Not IsEmpty(ActiveSheet.Cells(i, 1)) Then
            ActiveSheet.Cells(i, 17).Value = Date
            MonCorps = MonCorps & "<tr> <td align=""center"">" & Format(ActiveSheet.Cells(i, 2).Value, "dd/mm/yyyy") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 3).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 6).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 5).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 9).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 12).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 13) & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 14) & "</td></tr>"
        ElseIf ActiveSheet.Cells(i, 9).Value > 0 And IsEmpty(ActiveSheet.Cells(i, 17)) And Not IsEmpty(ActiveSheet.Cells(i, 1)) Then
            ActiveSheet.Cells(i, 17).Value = Date
            MonCorps = MonCorps & "<tr> <td align=""center"">" & Format(ActiveSheet.Cells(i, 2).Value, "dd/mm/yyyy") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 3).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 6).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 5).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 9).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 12).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 13) & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 14) & "</td></tr>"
        ElseIf ActiveSheet.Cells(i, 12).Value > 0 And IsEmpty(ActiveSheet.Cells(i, 17)) And Not IsEmpty(ActiveSheet.Cells(i, 1)) Then
            ActiveSheet.Cells(i, 17).Value = Date
            MonCorps = MonCorps & "<tr> <td align=""center"">" & Format(ActiveSheet.Cells(i, 2).Value, "dd/mm/yyyy") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 3).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 6).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 5).Value, "0.0") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 9).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & Format(ActiveSheet.Cells(i, 12).Value, "hh:mm") & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 13) & "</td>"
            MonCorps = MonCorps & "<td align=""center"">" & ActiveSheet.Cells(i, 14) & "</td></tr>"
        End If
    Next

en essayant de comprendre comment fonctionne celui que tu m'as écrit, parce que l'objectif du tableau, c'est quand même de fournir un récapitulatif des absences / retards / départs anticipés pour lesquels on n'a pas déjà alerté le responsable** avec en dernière ligne, le cumul depuis le début de la formation.

** C'est à dire

- chaque ligne du fichier de suivi d'assiduité pour laquelle :
ou il y a des heures d'absence (col E > 0) ET que la colonne G est vide,
ou il y a retard (col I >0) ET que la colonne G est vide,
ou il y a départ anticipé (col L >0) ET que la colonne G est vide
+ il faut donc que la macro ajoute la date du jour d'envoi du mail dans la colonne G aux bons endroits, pour que lors de l'envoi suivant, seules les nouvelles lignes d'absence etc. figurent au récapitulatif.

Si je n'y arrive pas, je reviendrais demander de l'aide.

Merci beaucoup en tous cas !!!

P.S. le fichier fourni contenait des données qui apparaissaient comme personnelles mais qui étaient fictives

Le 22/01/2024 à 21:57

le mieux c'est que tu me montre u tableau même avec excel

qui representerait le tableau dans le mail

donc oui tu confirme

comme avec w11 IE a été supprimé, il ne reste plus que la librairie de base microsoft de IE 8/9 XHTML

je m'en doutait fortement à l'avenir je travaillerais dans ce sens

j'attend un exemple de tableau

Le 22/01/2024 à 23:41

fait moi plaisir

colle ça dans un module vierge(ajoute en un si il faut)
et lance la sub test

tu devrait avoir dans le dossier ou se trouve le classeur un fichier html

dis moi si c'est ça que tu veux

Sub test()
    Set f = ActiveSheet
    Set doc = CreateObject("htmlfile")
    doc.body.innerhtml = "<table><tr></tr></table>"
    Set table = doc.getelementsbytagname("table")(0)
    table.Style.fontFamily = "calibri"
    table.cellspacing = 0
    Set capt = table.appendchild(doc.createelement("caption"))
    capt.innerhtml = "<b>Récapitulatif des retards et départs anticipés non pointés à ce jour </b>"
    capt.Style.backgroundcolor = "blue"
    capt.Style.Color = "white"

    'l'entete
    Set tr = table.appendchild(doc.createelement("TR"))
    tr.Style.backgroundcolor = "rgb(255,150,0)"
    tr.Style.Color = "blue"
    For Each cel In f.Range("A9").Resize(, 14).Cells
        Set TH = tr.appendchild(doc.createelement("th"))
        TH.innerhtml = cel
        TH.Style.Border = "2pt solid green"

    Next

    'les lignes des reards et depart naticipés
    For I = 12 To 500
        If f.Cells(I, 1) <> "" And Cells(I, "Q") = "" Then
            If f.Range("A" & I).Resize(, 13).DisplayFormat.Interior.Color <> vbWhite Then
                Set tr = table.appendchild(doc.createelement("tr"))
                For c = 1 To 14
                    Set TD = tr.appendchild(doc.createelement("td"))
                    TD.innerhtml = f.Cells(I, c).Text
                    With TD.Style
                        .Width = Round(f.Cells(I, c).Width) & "pt"
                        .Border = "0.5pt solid rgb(220,220,220)"
                       .TextAlign = "center"
                       If f.Cells(I, c).DisplayFormat.Interior.Color <> vbWhite Then
                            .backgroundcolor = "rgb(255,255,0)"
                            .Color = "red"
                            TD.innerhtml = "<B<<i>" & f.Cells(I, c).Text & "</i></B>"
                        End If
                        End With
                    Next
                End If
            Else: Exit For
            End If
        Next
        Debug.Print doc.body.innerhtml
        'ecriture du fichier html exemple
        q = FreeFile: Open ThisWorkbook.Path & "\test de tableau recap.html" For Output As #q: Print #q, doc.body.innerhtml: Close #q
    End Sub
image
Le 23/01/2024 à 11:46

Bonjour

en regardant ton code initial avec tout mes décodeur cérébraux possibles

je crois comprendre ce que tu veux

dis moi si cela te convient les couleurs tu t'arrangera

bien entendu ca prend les lignes qui n'ont pas été pointées en colonne Q avec la date du mail

image
Le 23/01/2024 à 12:50

re

Voila le mail complet donnerait ceci

j'en ai profité pour ajouter des sauts de lignes tes textes etaient trop long

image
Le 23/01/2024 à 18:46

Waow, je rallume mon mon ordi ce soir pensant me plonger dans le code que tu as donné initialement pour essayer de le bidouiller.... mais je vois le mail auquel tu arrives et c'est EXACTEMENT ça que je voulais arriver à faire (pas les couleurs , mais ça, je peux m'en arranger !).

C'est fantastique !

Du coup, le code final, ça serait quoi ?

Merci beaucoup.

Le 23/01/2024 à 19:42

re

alors pour te simplifier la tâche

j'ai séparé les code tableau html en fonction comme ca il sera plus facile d'intervenir dessus au moindre besoins de changement

alors c'est pas parfait mais ca match bien

si tu veux modifier les style c'est dans les blocs With /end with

je ne sais pas si ca march<e bien le principe de déjà fait( c'est à dire uniquement ce qui n'ont pas la date en "Q"

ou pas tu me diras

alors voila le module "Fonction_Mail_Outlook"

Option Explicit
Sub EnvoiMailTuteur()
    'Dim MesInvités(40) As String'?????
    Dim MonObjet$, MonCorps$, a, TextHtml
    a = Array("Date", "Heures<br>Planifiées", "Période<br>absence", "H.Absence", "Cumul Retards<br>hh:mm)", "Cumul Départs anticipés (hh:mm)", "A prévenu", "Justificatif")

    TextHtml = Range("MailPhrase1").Value & "<p>" & Range("MailPhrase2").Value & "<FONT COLOR=BLUE><b>" & ActiveSheet.Cells(1, 2) & "</b></font>, <br>" & ActiveSheet.Cells(1, 16) & ", " & _
               Range("MailPhrase3").Value & ActiveSheet.Cells(1, 6) & " " & Range("MailPhrase4").Value & ":<p>"

    MonObjet = Range("MailObjet").Value
    TextHtml = TextHtml & TableauRecapHtmL
    TextHtml = TextHtml & "<br><table><tr><th style=""background-color:#0000FF;color:#FFFFFF;"">Les horaires de la formation sont les suivants :</th></tr></table>"
    TextHtml = TextHtml & TableauHoraireHtmL
    TextHtml = TextHtml & "</br>" & Range("MailPhrase6").Value & "<p>" & _
               Range("MailPhrase7").Value & ActiveSheet.Cells(1, 2) & ".<p>" & _
               Range("MailPhrase8").Value & "</FONT>" & "<br>" & _
               "<FONT color=""blue"">" & Range("MailPhrase9").Value & "</FONT><br>" & _
               Range("MailPhrase10").Value & "<br>" & _
               Range("MailPhrase11").Value & "<br>" & _
               Range("MailPhrase12").Value & "<br>" & _
               Range("MailPhrase13").Value & "<br>" & _
               "<FONT color=""steelblue"">" & Range("MailPhrase14").Value & "</FONT>"
    MonCorps = TextHtml
    Call MonEnvoiMail(ActiveSheet.Cells(6, 1).Value, ActiveSheet.Cells(2, 2).Value & ";" & ActiveSheet.Cells(6, 5).Value, "", MonObjet, MonCorps, False)
End Sub
Sub MonEnvoiMail(ByVal MesDestinataires As String, ByVal MesDestinatairesCopie As String, ByVal MesDestinatairesCopieCachée As Variant, ByVal MonObjet As String, ByVal MonCorps As String, ByVal MonChoixPièceAttachée As Boolean)
   Dim I As Integer, MaMessagerie As Object, MonMail As Object, MaSignature As String
    Set MaMessagerie = CreateObject("Outlook.Application")
    If Not (MaMessagerie Is Nothing) Then
        Set MonMail = MaMessagerie.CreateItem(0)
        With MonMail
            .BCC = MesDestinatairesCopieCachée
            .CC = MesDestinatairesCopie
            .Subject = MonObjet
            .BodyFormat = 2
            .HTMLBody = MonCorps
            .To = MesDestinataires
            .Display
        End With
        Set MonMail = Nothing
        Set MaMessagerie = Nothing
    End If

End Sub

ensuite voila le module "fonctions_Tableau_html"

Option Explicit
Function TableauRecapHtmL()
    Dim F As Worksheet, Capt, TrH, TH, TR, TD, I&, Text1$, Col, c
    Dim MonObjet$, a, HtmlDoC As Object, Table
    Set F = ActiveSheet
    a = Array("Date", "Heures<br>Planifiées", "Période<br>absence", "H.Absence", "Cumul Retards<br>hh:mm)", "Cumul Départs anticipés (hh:mm)", "A prévenu", "Justificatif")

    Set HtmlDoC = CreateObject("htmlfile")
    With HtmlDoC
        .body.innerhtml = Text1 & "<table></table>"    'une table html avec 2 lignes vides
        Set Table = .getelementsbytagname("table")(0)

        'style general de la table
        With Table
            .Style.fontfamily = "calibri"           'font name pour toute la table et ses descendants
            .Style.bordercollapse = "collapse"      'bordures collées
            .Style.TextAlign = "center"             'alignement du texte dans pour toute la table html
            .Style.fontfamily = "calibri"           'font name pour toute la table html
        End With

        'création de la barre de titre du tableau
        Set Capt = Table.appendchild(HtmlDoC.createelement("caption"))
        With Capt
            .innerhtml = UCase("<b>Récapitulatif des retards et départs anticipés</b>")

            With .Style    'style de la bare de titre du tableau
                .backgroundcolor = "blue"
                .Color = "white"
                .Border = "1pt solid green"
            End With
        End With

        'creation de la ligne d'entête
        Set TrH = Table.appendchild(.createelement("TR"))

        'style de l'entête
        With TrH.Style
            .backgroundcolor = "rgb(255,255,200)"
        End With

        'ajout des cellules de l'entête
        For I = LBound(a) To UBound(a)
            Set TH = TrH.appendchild(.createelement("TH"))
            TH.innerhtml = a(I)

            'style des cellules de l'entête
            With TH.Style
                .Border = "1pt solid blue"
                .Width = "120pt"
                .Height = "40pt"
            End With
        Next

        Col = Array(2, 3, 6, 5, 9, 12, 13, 14)    'les colonnes du tableau excel à récupérer
        For I = 12 To 500
            If F.Cells(I, 1) <> "" And F.Cells(I, "Q") = "" Then
               If F.Range("A" & I).Resize(, 14).DisplayFormat.Interior.Color <> vbWhite Then
                    Set TR = Table.appendchild(.createelement("tr"))
                    For c = 0 To UBound(Col)
                        Set TD = TR.appendchild(.createelement("td"))
                        TD.innerhtml = F.Cells(I, Col(c)).Text

                        With TD.Style    'style des cellules du tableau
                            .Border = "1px solid rgb(230,230,230)"
                            .Width = "120pt"
                            Select Case Col(c)
                            Case 5, 9, 12: If F.Cells(I, Col(c)) > 0 Then .backgroundcolor = "rgb(255,180,230)"
                            End Select
                        End With
                    Next
                F.Cells(I, 17) = Date
               End If
            Else
                Exit For
            End If
        Next

        'LIGNE TOTAUX
        Set TR = Table.appendchild(.createelement("tr"))

        With TR.Style    'style de la ligne des totaux
            .backgroundcolor = "rgb(230,230,230)"
        End With

        'inscription des donnée de la ligne des totaux
        For c = 0 To UBound(Col)
            Set TD = TR.appendchild(.createelement("td"))
            TD.innerhtml = "<b>" & F.Cells(10, Col(c)).Text & "</B>"

            With TD.Style    'style des cellules de la ligne des totaux
                .Border = "1px solid rgb(230,230,23)"

            End With
        Next
        TR.Children(0).innerhtml = "<b>cumul depuis le<br>" & F.Cells(12, 2) & "</B>"

        TableauRecapHtmL = .body.innerhtml

    End With
End Function

Sub test()
    With CreateObject("internetexplorer.application")
        .navigate "about:blank"
        .document.write TableauHoraireHtmL
        .Visible = True

    End With
End Sub

Function TableauHoraireHtmL()
    Dim HtmlDoC, Table, TrH, TR, TD, Lig&, c, TH
    Set HtmlDoC = CreateObject("htmlfile")
    HtmlDoC.body.innerhtml = "<table></table>"   'une table html avec 2 ligne vides
    Set Table = HtmlDoC.getelementsbytagname("table")(0)

    'style general de la table
    With Table.Style
        .fontfamily = "calibri"    ' font name pour toute la table  et ses descendants
        .bordercollapse = "collapse"    'bordures collées
        .TextAlign = "center"
        .fontfamily = "calibri"
        .Border = "2px solid red"
    End With
    With Range("J2:L4")
        ''entête
        Set TrH = Table.appendchild(HtmlDoC.createelement("TR"))
        With TrH.Style    'style le la ligne d' entêtes
            .backgroundcolor = "rgb(255,255,200)"

        End With
        For c = 1 To .Columns.Count
            Set TH = TrH.appendchild(HtmlDoC.createelement("TH"))
            TH.innerhtml = .Cells(1, c).Text
            With TH.Style    ' style des cellules du tableau html
                .Border = "1px solid blue"
                .Width = "100pt"
            End With

        Next

        For Lig = 2 To .Rows.Count
            Set TR = Table.appendchild(HtmlDoC.createelement("tr"))
            For c = 1 To .Columns.Count
                Set TD = TR.appendchild(HtmlDoC.createelement("td"))
                TD.innerhtml = "<B><I>" & .Cells(Lig, c).Text & "</I></B>"
                With TD.Style
                    .Border = "1px solid rgb(230,230,230)"
                    .Color = "blue"
                End With
            Next
        Next
    End With
    TableauHoraireHtmL = HtmlDoC.body.innerhtml
End Function

et du coup le fichier dans son état actuel

Le 23/01/2024 à 20:12

Je viens de faire quelques tests, ça semble marcher nickel

Je n'ai pas testé toutes les configurations, je ferai ça demain et je passerai en résolu.

Un immense merci à nouveau !!!

Le 23/01/2024 à 20:34

de rien

n'hésite pas si soucis ou que tu comprends pas quelque chose

Le 30/01/2024 à 17:32

La grippe est passée par là et m'a ralentie... je reviens pour clôre le sujet qui est résolu. Encore mille mercis pour la solution clé en main, moi qui pensais qu'il y aurait juste à remanier un peu le code de départ, oops...

Le 30/01/2024 à 23:28

re

Bonsoir pheeebzzz

ravi pour toi

Rechercher des sujets similaires à "macro creation feuille calcul formatage corps mail envoye"