Microsoft 365 Problème avec la fonction publishobjects

dje14 · 27 Janvier 2025

Bonjour as tous,

Je souhaiterais copier un tableau excel dans un mail outlook via un bouton sans modification de forme.

J'ai pu voir que pour cela il fallait convertr en HTML.

Pour cela, j'ai pris des bouts de codes VBA sur le net (et oui malheureusement je ne suis pas un expert en la matière, mais plutôt autodidact sur le sujet).

Celle-ci fonctionne mais pas à tous les coups. Je rencontre un problème avec la fonction PublishObjects qui de temps en temps fonctionne mais la plupart du temps non et je n'en trouve malheureusement pas la raison.

Je vous copie ma fonction (qui peu vous sembler aberrante peut-être).

Sub envoimail1()
Dim Fichier As Variant

Dim i As Integer
Worksheets(Array("Feuil1")).Select
Range("A4: D66").Activate

Dim MaMessagerie As Object
Dim MonMessage As Object
Set MaMessagerie = CreateObject("Outlook.Application")
Set MonMessage = MaMessagerie.CreateItem(0)
MonMessage.To = "toto@gmail.com"
MonMessage.Subject = "Bilan du " & Date
Corps = converthtml(Range("A4: D66"))
Corps = Corps & "<p>"
Corps = Replace(Corps, "align=center", "align=left")
MonMessage.Body = contenu
MonMessage.HTMLBody = Corps
MonMessage.Send
Set MaMessagerie = Nothing

MsgBox "Bilan envoyé"

End Sub

Function converthtml(plage As Object)
Dim lmf, fso, ts, r
Range("Feuil1").Cells(1, 1).Select
lmf = "abctext.html"
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, lmf, plage.Parent.Name, plage.Address, xlHtmlStatic, "Book1_26691", "")
.Publish (True)
.AutoRepublish = False
End With
Set fso = CreateObject("scripting.filesystemobject")
Set ts = fso. OpenTextfile(lmf)
r = ts.readall
ts.Close
converthtml = r
End Function

Merci d'avance pour votre aide.

Cdt

dje14 · 29 Janvier 2025

dje14 à dit:
Bonjour,

comme je le disais au début de mon poste, je suis autodidacte sur le sujet et j’admets ne pas comprendre le code que vous venez de m'envoyer.

ce code va me permettre de déboguer?

ou dois-je le placer? Ou dois-je remplacer une partie du moins par celui-ci?

Une idée me vient suite à vos idées. Serait il possible que cela bloque du fait que le fichier soit sur un sharepoint?

Dans ce cas, il conviendrait peut-être que je crée une copie du fichier de manière temporaire dans le local PC afin de l'envoyé et ensuite le supprimer.

Quand pensez-vous?

Cdt

A oui, je pense avoir compris.

le seul truc c'est qu'il ne prend pas Range("A4:E67").Activate, il me prend tous.

et je ne vois pas ou faire une modif pour éviter cela?

Sinon la méthode à l'air de vouloir fonctionner.

Cdt

jurassic pork · 29 Janvier 2025

Hello,
bon j'ai trouvé une autre solution en utilisant le presse-papier. Cette solution utilise le module de classe stdclipboard de l'excellente bibliothèque stdVBA. Le module de classe est à intégrer au classeur qui l'utilise.
Voici un exemple d'utilisation pour convertir une plage de données en html :

VB:

Sub Range2Html()  ' Jurassic Pork  2025
Dim Corps
Sheets("Médailles").Range("A1:F15").Copy
stdClipboard.Await
Corps = stdClipboard.value(stdClipboard.RegisterFormat("HTML Format"))
Corps = UTF8ToWin1252(Corps) ' conversion utf8 vers Ansi
Corps = NettoyageHTML(Corps) ' rectification du HTML
'Load UsfTB: UsfTB.TextBox1.text = Corps:  UsfTB.Show
Load UsfHTML
UsfHTML.WebBrowser1.Navigate2 "about:&nbsp;": DoEvents
UsfHTML.WebBrowser1.Document.body.innerHTML = Corps
UsfHTML.Show
End Sub

Le principe :

On copie la plage de données dans le presse-papiers.
On attend que le presse-papier soit prêt.
On récupère les données en HTML à partir du presse-papiers. Les données sont en utf-8 et en tableau d'octets.
Avec la fonction UTF8ToWin1252 on convertit le tableau d'octets en chaîne avec aussi la conversion utf-8 -> Ansi. Cette Fonction utilise adodb.stream.
Ensuite on "nettoie" le HTML : Suppression du texte au début du HTML, remplacement de utf-8 par windows-1252 et alignement de la table au centre.
On affiche le HTML dans un contrôle webBrowser dans un formulaire.

En pièce jointe un classeur de test qui contient le module de classe stdClipboard et les fonctions utilisées dans le code ci-dessus.
Attention il y avait une erreur dans le module de classe que j'ai corrigé. J'ai signalé cette erreur au créateur du module de classe. Pour utiliser ce module de classe dans votre classeur , le recopier (par drag and drop ou export module) dans votre classeur.

Ami calmant, J.P

dje14 · 29 Janvier 2025

jurassic pork à dit:
Hello,
bon j'ai trouvé une autre solution en utilisant le presse-papier. Cette solution utilise le module de classe stdclipboard de l'excellente bibliothèque stdVBA. Le module de classe est à intégrer au classeur qui l'utilise.
Voici un exemple d'utilisation pour convertir une plage de données en html :

VB:

Sub Range2Html() ' Jurassic Pork 2025 Dim Corps Sheets("Médailles").Range("A1:F15").Copy stdClipboard.Await Corps = stdClipboard.value(stdClipboard.RegisterFormat("HTML Format")) Corps = UTF8ToWin1252(Corps) ' conversion utf8 vers Ansi Corps = NettoyageHTML(Corps) ' rectification du HTML 'Load UsfTB: UsfTB.TextBox1.text = Corps: UsfTB.Show Load UsfHTML UsfHTML.WebBrowser1.Navigate2 "about: ": DoEvents UsfHTML.WebBrowser1.Document.body.innerHTML = Corps UsfHTML.Show End Sub

Le principe :

On copie la plage de données dans le presse-papiers.

On attend que le presse-papier soit prêt.

On récupère les données en HTML à partir du presse-papiers. Les données sont en utf-8 et en tableau d'octets.

Avec la fonction UTF8ToWin1252 on convertit le tableau d'octets en chaîne avec aussi la conversion utf-8 -> Ansi. Cette Fonction utilise adodb.stream.

Ensuite on "nettoie" le HTML : Suppression du texte au début du HTML, remplacement de utf-8 par windows-1252 et alignement de la table au centre.

On affiche le HTML dans un contrôle webBrowser dans un formulaire.

En pièce jointe un classeur de test qui contient le module de classe stdClipboard et les fonctions utilisées dans le code ci-dessus.
Attention il y avait une erreur dans le module de classe que j'ai corrigé. J'ai signalé cette erreur au créateur du module de classe. Pour utiliser ce module de classe dans votre classeur , le recopier (par drag and drop ou export module) dans votre classeur.

Ami calmant, J.P

Bon, je pense que cela fonctionne enfin grâce à vous tous.

voilà le résultat final. Si vous voyez des améliorations n’hésitè pas surtout.

Sub envoimail1()

If Range("H3") = "0" Then

Dim Fichier As Variant

Dim i As Integer
Worksheets(Array("Feuil1")).Select
Range("A4:E67").Activate
Debug.Print RangetoHTML(ActiveSheet.UsedRange)

Dim MaMessagerie As Object
Dim MonMessage As Object
Set MaMessagerie = CreateObject("Outlook.Application")
Set MonMessage = MaMessagerie.CreateItem(0)
MonMessage.To = "toto@gmail.com"
MonMessage.Subject = "Bilan"
Corps = RangetoHTML(ActiveSheet.UsedRange)
Corps = Corps & "<p>"
Corps = Replace(Corps, "align=center", "align=left")
MonMessage.Body = contenu
MonMessage.HTMLBody = Corps
MonMessage.Send
Set MaMessagerie = Nothing

MsgBox "Bilan envoyé"

Else
MsgBox "Toutes les cases ne sont pas renseignées, BILAN NON ENVOYÉ"
End If

End Sub

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"

'Copiez la plage et créez un nouveau classeur pour y coller les données
Sheets("Feuil1").Range("A4:E67").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
'Publier la feuille dans un fichier htm
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

'Lire toutes les données du fichier htm dans 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😛ublishsource=", _
"align=left x😛ublishsource=")

'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

Encore une fois merci beaucoup à vous.

Cdt

dje14 · 30 Janvier 2025

Bonjour à tous,

cette solution fonctionne très bien. je vous remercie énormément pour le temps que vous m'avez consacré.

Je vais encore abusé de vous mais, est-il possible d'empêcher l'action du bouton avant 7h45? si oui,je veux bien savoir comment par curiosité.

Bonne journée à vous

Cordialement

dysorthographie · 30 Janvier 2025

Bonjour,
Tu peux écrire un fichier vbscipt.
Foncier.vbs

VB:

With CreateObject("Excel.Application")
    With .Workbooks.Open("C:\chemin\vers\ton\classeur.xlsm") ' Utilise un fichier .XLSM
        .Application.Run "'classeur.xlsm'!NomDeTaMacro" ' Nom du classeur requis si la macro est dans un module
        .Save
        .Close False
    End With
    .Quit
End With

Tu peux execter ce vbscipt Via le gestionnaire de tâches tous les jours à 7:45

dje14 · 30 Janvier 2025

dysorthographie à dit:
Bonjour,
Tu peux écrire un fichier vbscipt.
Foncier.vbs

VB:

With CreateObject("Excel.Application") With .Workbooks.Open("C:\chemin\vers\ton\classeur.xlsm") ' Utilise un fichier .XLSM .Application.Run "'classeur.xlsm'!NomDeTaMacro" ' Nom du classeur requis si la macro est dans un module .Save .Close False End With .Quit End With

Tu peux execter ce vbscipt Via le gestionnaire de tâches tous les jours à 7:45

Alors je ne suis pas sur que l'on soit sur la même longueur d'onde ou c'est moi qui m'exprime mal ou qui ne comprend pas aussi.

Mais en faite pour lancer l'envoi du mail je le fais via le bouton.

Est-il possible, que si je clique sur ce bouton avant 7h45 qu'il me renvoi un msgbox ( exemple : il est trop tôt si avant), mais qu'il fasse bien sont action d'envoi si il est plus de 7h45?

Cdt

dysorthographie · 30 Janvier 2025

Tu as raison, je ne sais pas pourquoi je suis intervenu sur ton poste désolé.

Je pensais que tu pourrais être intéressé si ta macro s'executait automatiquement tous les matins a 7:45 ou 8:00 selon ton choix.

jurassic pork · 30 Janvier 2025

dje14 à dit:
Est-il possible, que si je clique sur ce bouton avant 7h45 qu'il me renvoi un msgbox ( exemple : il est trop tôt si avant), mais qu'il fasse bien sont action d'envoi si il est plus de 7h45?

Il suffit que tu fasses un test comme celui-ci :

VB:

Sub VerifHeure()
    If Time < TimeSerial(7, 45, 0) Then
        MsgBox " Il est trop tôt"
    Else
        MsgBox " Vous pouvez envoyer un message"
    End If
End Sub

Ami calmant, J.P

Microsoft 365 Problème avec la fonction publishobjects

dje14

XLDnaute Nouveau

dje14

XLDnaute Nouveau

jurassic pork

XLDnaute Impliqué

Pièces jointes

dje14

XLDnaute Nouveau

dje14

XLDnaute Nouveau

dysorthographie

XLDnaute Accro

dje14

XLDnaute Nouveau

dysorthographie

XLDnaute Accro

jurassic pork

XLDnaute Impliqué

Discussions similaires

Microsoft 365 Problème avec la fonction publishobjects

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Impliqué

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Accro

XLDnaute Nouveau

XLDnaute Accro

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency