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 .
Pour résumé le poste trouvé ici: Intégralité du post
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