Microsoft 365 Problème avec la fonction publishobjects

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion dje14
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
D

dje14

XLDnaute Nouveau
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
 
Trier par date Trier par votes
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
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
 

Pièces jointes

Vote positif 0 Vote négatif
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:&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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif
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?
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Résolu(e)
XL 2021 Céer un fichier (.text) avec VBA pour enregistrer les évènements dans un journal
Réponses
4
Affichages
527
arnoldbrice19
A
D
  • Résolu(e)
Microsoft 365 Problème interférences entre macros
Réponses
14
Affichages
147
Phil69970
Phil69970
Cédric06400
  • Résolu(e)
XL 2021 Revenir sur Excel
Réponses
6
Affichages
431
Franc58
F
R
  • Question Question
Microsoft 365 Inserer copie d'ecran ou plage de cellules dans mail
Réponses
4
Affichages
943
romubzh35
R
S
  • Résolu(e)
Microsoft 365 Fusion de 2 macro VBA (selection envoi de mail + envoie de fichier PDF)
Réponses
6
Affichages
2 K
soNZOOO
S
M
  • Question Question
XL 2016 Envoi courriel copier/coller avec mise en forme (corps couuriel)
Réponses
2
Affichages
1 K
MONTREAL2020
M
I
  • Question Question
XL 2019 Envoyer image et mise en forme conditionnelle dans un mail
Réponses
1
Affichages
914
patricktoulon
patricktoulon
M
  • Question Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
828
Oneida
Oneida
Philou0607
  • Question Question
XL 2010 Sauts de ligne dans envoi mail sous VBA
Réponses
5
Affichages
5 K
Staple1600
Staple1600
T
  • Question Question
Envoie d'un mail vba sous condition
Réponses
2
Affichages
4 K
TEMAGOULTFARID
T
R
  • Question Question
XL 2016 Envoyer un fichier excel par email via outlook
Réponses
8
Affichages
3 K
rayms
R
A
  • Question Question
XL 2010 Générer mail avec corps de mail / destinataire et PJ
Réponses
0
Affichages
700
Alghorn
A
chris6999
  • Question Question
Microsoft 365 Envoi mail depuis boite Outlook pré-identifiée
Réponses
3
Affichages
2 K
chris6999
chris6999
chris6999
  • Question Question
Microsoft 365 Envoi mail depuis boite Outlook pré-identifiée
Réponses
0
Affichages
674
chris6999
chris6999
F
  • Question Question
XL 2010 Envoi d'un mail notifiant une modification à plusieurs destinataires
Réponses
5
Affichages
1 K
Hasco
Hasco
chris6999
  • Question Question
Microsoft 365 MSG Outlook via VBA pb de lien et de signature
Réponses
0
Affichages
727
chris6999
chris6999
D
  • Question Question
Résolu : email automatique sous excel
Réponses
13
Affichages
1 K
DG-59
D
Magic_Doctor
  • Question Question
Problème avec boucle tordue et la fonction Switch
Réponses
5
Affichages
1 K
Magic_Doctor
Magic_Doctor
N
  • Question Question
XL 2016 Problème macro ouverture Outlook a l'arrièce plan avec la fonction Shell
Réponses
2
Affichages
3 K
NicoleBelge
N
Claudy
  • Question Question
Compile error Can't find project or library
Réponses
11
Affichages
4 K
Dranreb
Dranreb
Retour