Garder lien HyperText des cellules, macro copie tableau vers outlook

Bonjour à tous !!

Voilà tout, comme à mon habitude, comme je suis amateur sur excel, quand je veux effectuer une fonction, je tape sur internet et je copie colle les codes et

l'aménage pour mon utilisation, bon je pense pas être le seul à le faire

J'ai trouvé un topic avec une fonction et une macro pour copier/coller un tableau Excel directement dans Outlook avec pré_message, contact etc...

pile poil ce que je voulais, j'arrive à m'en servir, modifier les infos que je veux (les choses simple), mais voilà, dans mon tableau excel dans la premiere

colonne ce sont des liens hypertexte (équivalent colonne "nom" voir image ci-dessous), et avec la macro en question, elle ne les copies pas

en plus le code est bien compliqué car ce que j'ai compris ça transforme le tableau excel en HTML pour le coller dans outlook, ça doit

être à ce moment que le lien hypertexte casse .

Une personne souhaite savoir comment coller directement un tableau excel vers outlook comme ceci (résultat attendu)i:

Puis un intervenant du forum Joe.Levrai (qui est peut-être aussi sur ce forum !)

lui propose ceci, une fonction + une macro:

La fonction:

Function RangetoHTML(ByVal rng As Range)
    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"
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)

        .Cells(1).PasteSpecial Paste:=12
        .Cells(1).PasteSpecial Paste:=-4122
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            .Columns.AutoFit
            .Rows.AutoFit
        On Error GoTo 0
    End With

    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

    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=")

    TempWB.Close savechanges:=False
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing

End Function

Puis la Macro:

Sub copie_outlook()

' on récupère la plage du tableau
Set rng = Range("A1:Q18")

' on crée un mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

' caractéristiques du mail
With OutMail
    .To = "toto@toto.fr"
    .CC = "titi@titi.fr"
    .Subject = "Mon Titre de mail"
    .HTMLBody = "Bonjour à tous, voici un tableau issu d'un fichier excel  : " & RangetoHTML(rng)

    ' afficher
    .Display

    ' envoyer
    '.Send
End With

Set OutApp = Nothing
Set OutMail = Nothing

end sub

Je pense sans me tromper que le problème se trouve au niveau de la "fonction", car j'arrive à bien comprendre la parti "macro" et je ne vois pas pourquoi ça retirerais mes liens hypertextes.

Voilà en espérant que quelqu'un aura une solution pour moi, car c'est rageant cette macro est parfaite pour mon utilisation, il manque un chouilla rien mais que je ne peux pas laisser de coté le lien hypertexte.

PS: les liens hypertextes seront toujours dans la colonne A de mon tableau a partir de la ligne 2.

Merci d'avance pour vos réponses !!

C'est bon j'ai trouvé !!!

j'ai exécuté la macro pas à pas,

et c'est le code suivant qui causait problème:

.Cells(1).PasteSpecial Paste:=12

j'ai trouvé sur le site microsoft ce que signifiait paste=12

https://docs.microsoft.com/fr-fr/office/vba/api/excel.xlpastetype

en fait ça colle seulement les valeur,

j'ai donc remplacé par

.Cells(1).PasteSpecial Paste:=13

et tout est rentré dans l'ordre