Comment faire pour coller plusieurs plage de cellules dans le corps du message à l'aide de VBA Excel
À l'aide de code ci-dessous je suis en mesure de coller les cellules dans la plage de A1:B20
dans le corps de l'email.
Je veux coller une plage de cellules A33:B36
dans le corps de l'e-mail juste en dessous de A1:B20
gamme.
Sub Trigger_Email()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim StrBody As String
StrBody = "Hello Recruitment Team," & "<br>" & "<br>" & _
"Please work on the below request details and open it for Vendor Sourcing. The details of the RRF are mentioned in the attachment." & "<br><br>"
Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
'Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a fixed range if you want
Set rng = Sheets("Sheet1").Range("A1:B20").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "[email protected];[email protected]"
.CC = "G=EGS-IND-SC-Managers" & ";" & Cells(5, 2)
.BCC = ""
.Subject = "RRF for Vendor Sourcing - " & Cells(3, 2)
.HTMLBody = StrBody & rangetoHTML(rng)
.Attachments.Add ActiveWorkbook.FullName
.Display 'or use .Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Voici le code pour le transformer ensuite en un élément HTML :
Function rangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
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
Vous devez vous connecter pour publier un commentaire.
Cela devrait faire l'affaire:
Copie de la présente sous et remplacer l'original de votre sous-marin avec elle (la Fonction doit être laissé intact).
Votre façon de demander implique que vous n'avez aucune expérience avec VBA à tous et il suffit d'utiliser ce code. Si vous avez besoin pour faire avancer votre code de toute autre manière, je vous suggère d'essayer de comprendre le code de sorte que vous pourrait faire des modifications vous-même. Je suis juste en ajoutant des fractions ici vous pouvez facilement le faire par vous-même.