Saut de ligne indésirable sur un mail généré automatiquement

Le 14/04/2020 à 10:33

Bonjour à tous,

Je crois que ce sujet n'a pas encore été traité. Je génère des mails automatiques grâce à une macro vba que j'ai créée. Le contenu de ce mail est un petit texte suivi de plusieurs tableaux (que je ne peux pas vous montrer pour des raisons d'autorisation). Le texte et les tableaux sont dans des cellules excel (organisé de façon à pouvoir les sélectionner sous forme d'une range). J’utilise dans mon programme pour générer le mail:

With olNewEmail 'Attach template

.To = liste_mail

.BCC = ""

.CC = “”

.HTMLBody = RangetoHTML(rng)

.Subject = Title

.Display

End With

Et pour y insérer une Range excel, j’ai utilise la fonction RangetoHTML suivante (qui n’est pas de moi) :

Function RangetoHTML(rng As Range)

' Changed by Ron de Bruin 28-Oct-2006

' Working in Office 2000-2016

Dim fso As Object

Dim ts As Object

Dim TempFile As String

Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in

rng.Copy

Set TempWB = Workbooks.Add(1)

With TempWB.Sheets(1)

.Cells(1).PasteSpecial Paste:=8

.Cells(1).PasteSpecial xlPasteValues, , False, False

.Cells(1).PasteSpecial xlPasteFormats, , False, False

.Cells(1).Select

Application.CutCopyMode = False

On Error Resume Next

.DrawingObjects.Visible = True

.DrawingObjects.Delete

On Error GoTo 0

End With

'Publish the sheet to a htm file

With TempWB.PublishObjects.Add( _

SourceType:=xlSourceRange, _

Filename:=TempFile, _

Sheet:=TempWB.Sheets(1).Name, _

Source:=TempWB.Sheets(1).UsedRange.Address, _

HtmlType:=xlHtmlStatic)

.Publish (True)

End With

'Read all data from the htm file into RangetoHTML

Set fso = CreateObject("Scripting.FileSystemObject")

Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.readall

ts.Close

RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

"align=left x:publishsource=")

'Close TempWB

TempWB.Close savechanges:=False

'Delete the htm file we used in this function

Kill TempFile

Set ts = Nothing

Set fso = Nothing

Set TempWB = Nothing

End Function

Mon problème est que ma Range n’est pas collée sur la première ligne du mail mais sur la deuxième. Le mail commence donc par un saut de ligne, ce que j’aimerais corriger. Je ne comprends pas d’où cela vient (J'ai bien sûr vérifié que je n'avais pas sélectionner une ligne de trop dans ma range). Si l’un de vous a une idée il m’aiderait grandement !

Merci d’avance de me lire.

Le 14/04/2020 à 13:16

Bonjour, et

J'utilise un autre code qui ne génère pas de fichier temporaire. C'est du "pur" html.

Insère un nouveau module avec ce code

Function tableHTML(plage As Range) As String
tableHTML = "<head><style>table, th, td {border: 1px solid black; border-collapse:collapse;}</style></head><TABLE width=" & plage.Columns.Width & "><tr>"
With plage
    For Each colonne In plage.Columns
        tableHTML = tableHTML & "<th width=" & colonne.Width & ">" & html(.Cells(1, colonne.Column - .Column + 1)) & "</th>"
    Next colonne
    If .Rows.Count > 1 Then
        For i = 2 To .Rows.Count
            tableHTML = tableHTML & "<tr>"
            For j = 1 To .Columns.Count
                tableHTML = tableHTML & "<td bgcolor=" & DecVersHexa(.Cells(i, j).Interior.Color) & "><font color=" & DecVersHexa(.Cells(i, j).Font.Color) & ">" & html(.Cells(i, j)) & "</font></td>"
            Next j
            tableHTML = tableHTML & "</tr>"
        Next i
    End If
End With
tableHTML = tableHTML & "</TABLE>"
End Function

Function DecVersHexa(ByVal valeur As Long) As String
    rouge = Left(Hex(Int(valeur Mod 256)) & "00", 2)
    vert = Left(Hex(Int((valeur Mod 65536) / 256)) & "00", 2)
    bleu = Left(Hex(Int(valeur / 65536)) & "00", 2)
    DecVersHexa = rouge & vert & bleu
End Function

Function html(cel As Range)
html = ""
With cel
    For i = 1 To Len(.Value)
        deb_style = ""
        fin_style = ""
        If .Characters(Start:=i, Length:=1).Font.Underline <> xlUnderlineStyleNone Then
            deb_style = "<u>"
            fin_style = "</u>"
        End If
        If .Characters(Start:=i, Length:=1).Font.Bold Then
            deb_style = deb_style + "<b>"
            fin_style = "</b>" + fin_style
        End If
        If .Characters(Start:=i, Length:=1).Font.Italic Then
            deb_style = deb_style + "<i>"
            fin_style = "</i>" + fin_style
        End If
        Select Case Asc(Mid(.Value, i, 1))
            Case Is = 10
                html = html & "<br/>"
            Case Is > 127
                html = html & deb_style & "&#" & Asc(Mid(.Value, i, 1)) & ";" & fin_style
            Case Else
                html = html & deb_style & Mid(.Value, i, 1) & fin_style
        End Select
    Next
End With
html = Replace(html, "</i><i>", "")
html = Replace(html, "</b><b>", "")
html = Replace(html, "</u><u>", "")
End Function

et remplace dans ta macro RangetoHTML par tableHTML

S'il reste une ligne blanche, on peut faire encore plus simple

Tu peux aussi remplacer

.HTMLBody = RangetoHTML(rng)

par

.HTMLBody = RangetoHTML(rng) & .HTMLbody

afin de conserver ta signature outlook

10creation-tableau-et-page-html.xlsm (19.61 Ko)
Le 17/04/2020 à 06:18

As-tu testé ma proposition ? est-ce qu'elle supprime le problème ?

Le 17/04/2020 à 08:35

Bonjour,

J'avais bien vu ton message, merci beaucoup de ta réponse. Je vais tester ce matin, je n'avais pas eu le temps jusqu'à présent. Je te fais un retour aussitôt

Le 17/04/2020 à 09:03

Si ce n'est pas le cas, je peux aménager et simplifier ... (je ne peux plus tester car je ne travaille plus avec outlook).

Le 17/04/2020 à 14:21

J'ai une erreur de type missmatch à la ligne "For i = 1 To Len(.Value)"... Je ne comprends pas le problème malheureusement.

Le 17/04/2020 à 15:25

Curieux !

Est-ce que tu as une erreur quand tu le fais à partir du fichier posté. C'est-à-dire quand tu lance la macro

Sub table()

ou

Sub page()

?

Comment dans ton fichier fais-tu appel à la fonction ?

Le 20/04/2020 à 10:10

Bonjour,

Je fais appel à ma macro "mail" qui fait appelle à la fonction tablehtml que tu m'as envoyé pour générer le mail. ce qui donne ça :

Dim Title$

Set olLook = CreateObject("Outlook.Application")

Set olNewEmail = olLook.CreateItem(0)

Title = Sheets("Template_Mail").Cells(2, 2)

With olNewEmail 'Attach template

.To = liste_mail

.BCC = ""

.CC = ""

.HTMLBody = tableHTML(rng)

.Subject = Title

.Display

End With

Quand j’exécute sub table ou sub page à partir de ton fichier, il n'y a aucun problème bizarrement. Je vais ré-essayer de comprendre aujourd'hui. Je te dis si je comprends le problème. Merci de ton aide précieuse !

Le 20/04/2020 à 12:30

Merci pour ce retour.

Comment est défini rng ?

Le 20/04/2020 à 14:30

Voici le code complet:

Sub Mail()

Dim rng As Range

Set rng = Nothing

On Error Resume Next

Set rng = Sheets("RESULTS").Range("B1:H77").SpecialCells(xlCellTypeVisible)

On Error GoTo 0

Dim colonne_client As Integer

colonne_client = 2

While Sheets("Template_Mail").Cells(27, colonne_client + 1) <> ""

colonne_client = colonne_client + 1

Dim ligne As Integer, liste_mail As String

ligne = 28

liste_mail = ""

While Sheets("Template_Mail").Cells(ligne, colonne_client) <> ""

liste_mail = liste_mail & Sheets("Template_Mail").Cells(ligne, colonne_client) & ";"

ligne = ligne + 1

Wend

Dim Title$

Set olLook = CreateObject("Outlook.Application")

Set olNewEmail = olLook.CreateItem(0)

Title = Sheets("Template_Mail").Cells(2, 2)

With olNewEmail 'Attach template

.To = liste_mail

.BCC = ""

.CC = ""

.HTMLBody = tableHTML(rng)

.Subject = Title

.Display

End With

'strEmailText

Wend

End Sub

Function tableHTML(plage As Range) As String

tableHTML = "<head><style>table, th, td {border: 1px solid black; border-collapse:collapse;}</style></head><TABLE width=" & plage.Columns.Width & "><tr>"

With plage

For Each colonne In plage.Columns

tableHTML = tableHTML & "<th width=" & colonne.Width & ">" & html(.Cells(1, colonne.Column - .Column + 1)) & "</th>"

Next colonne

If .Rows.Count > 1 Then

For i = 2 To .Rows.Count

tableHTML = tableHTML & "<tr>"

For j = 1 To .Columns.Count

tableHTML = tableHTML & "<td bgcolor=" & DecVersHexa(.Cells(i, j).Interior.Color) & "><font color=" & DecVersHexa(.Cells(i, j).Font.Color) & ">" & html(.Cells(i, j)) & "</font></td>"

Next j

tableHTML = tableHTML & "</tr>"

Next i

End If

End With

tableHTML = tableHTML & "</TABLE>"

End Function

Function DecVersHexa(ByVal valeur As Long) As String

rouge = Left(Hex(Int(valeur Mod 256)) & "00", 2)

vert = Left(Hex(Int((valeur Mod 65536) / 256)) & "00", 2)

bleu = Left(Hex(Int(valeur / 65536)) & "00", 2)

DecVersHexa = rouge & vert & bleu

End Function

Function html(cel As Range)

html = ""

With cel

For i = 1 To Len(.Value)

deb_style = ""

fin_style = ""

If .Characters(Start:=i, Length:=1).Font.Underline <> xlUnderlineStyleNone Then

deb_style = "<u>"

fin_style = "</u>"

End If

If .Characters(Start:=i, Length:=1).Font.Bold Then

deb_style = deb_style + "<b>"

fin_style = "</b>" + fin_style

End If

If .Characters(Start:=i, Length:=1).Font.Italic Then

deb_style = deb_style + "<i>"

fin_style = "</i>" + fin_style

End If

Select Case Asc(Mid(.Value, i, 1))

Case Is = 10

html = html & "<br/>"

Case Is > 127

html = html & deb_style & "&#" & Asc(Mid(.Value, i, 1)) & ";" & fin_style

Case Else

html = html & deb_style & Mid(.Value, i, 1) & fin_style

End Select

Next

End With

html = Replace(html, "</i><i>", "")

html = Replace(html, "</b><b>", "")

html = Replace(html, "</u><u>", "")

End Function

Je fais donc appelle à la macro "mail" pour exécuter le code.

Le 20/04/2020 à 15:21

Un essai simplifié :

Sub test()

    Dim rng As Range
    Set rng = Nothing
    On Error Resume Next
        Set rng = Sheets("RESULTS").Range("B1:H77").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    MsgBox tableHTML(rng)

End Sub

fonctionne correctement !

Je pense que rng n'est pas initialisé !

Pourquoi encadres-tu Set rng avec

    On Error Resume Next

    On Error GoTo 0

Je te conseille d'enlever ces 2 instructions, car si cela produit une erreur (ex : nom exact de la feuille), ta macro n'a pas de sens. Exemple d'erreur : le nom de la feuille est suivi d'un espace !

Le 21/04/2020 à 12:44

Oui ça a bien l'air d'être le soucis, je n'ai plus le problème ! Je vais essayer de comprendre l’erreur maintenant Merci beaucoup pour ton aide !

Rechercher des sujets similaires à "saut ligne indesirable mail genere automatiquement"