J'utilise Excel 2003 et j'ai du mal à attacher des cellules sur le corps d'un email. J'ai reçu une partie du code http://www.rondebruin.nl/mail/folder3/mail4.htm mais ça ne marche pas pour moi. Ce qui m'arrive, c'est qu'une feuille de calcul apparaîtrait sur laquelle il n'y aurait pas d'examen par les pairs et un message d'erreur disant "erreur d'exécution '1004' La méthode PasteSpecial de la classe Range a échoué". S'il vous plaît fournir une assistance.VBA-Problème avec l'attachement des cellules dans le corps de l'email (Outlook)
Voici le code (le code en gras est l'erreur):
'' Creates Email
Sub Email_Click()
Dim sDate As Date
sDate = ThisWorkbook.Sheets("SheetA").Range("H4").Value
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim tmp
Set olApp = New Outlook.Application
'' Location of email template
Set olMail = olApp.CreateItem(olMailItem)
ThisWorkbook.Worksheets("SheetB").Activate
Application.ActiveSheet.Columns("A:E").AutoFit
Dim totalRows As Integer
totalRows = Application.ActiveSheet.UsedRange.Rows.count
With olMail
'' Subject
.Subject = "Email"
.BodyFormat = olFormatHTML
.To = "[email protected]"
'' Body
.HTMLBody = RangetoHTML(Application.ActiveSheet.Range("A1:E" & totalRows))
.Display
End With
Set olMail = Nothing
Set olApp = Nothing
ThisWorkbook.Worksheets("Base Sheet").Activate
End Sub
Function RangetoHTML(rng As Range)
'' Changed by Ron de Bruin 28-Oct-2006
'' Working in Office 2000-2007
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
S'il vous plaît votre code en retrait d'au moins 4 caractères de l'espace pour le sélectionner. C'est presque illisible de cette façon. Je ne peux pas l'éditer ... – Atmocreations
La syntaxe semble un peu étrange par rapport à la documentation, mais comme c'est une erreur d'exécution je suppose que ce n'est pas seulement ça. Mais FWIW je m'attendais à ce que la ligne en surbrillance ressembler plus: .Cells (1) .PasteSpecial Paste: = 8, Opération: = xlPasteValues, SkipBlanks: = False, Transpose: = Faux – Mikeb
déboguer votre code étape par étape par ajouter un point d'arrêt. Vous devriez vérifier si TempWB.Sheets (1) retourne vraiment un objet. Il est dangereux de supposer cela quand même – Atmocreations