![](/img/trans.png)
[英]When writing an array of values to a range, how do I prevent excel from ignoring local date time formats
[英]How to keep formats when I copy a range from Excel to outlook
您好,我有一個 Excel 表格,其中包含一些格式10(Red) -> 15(Green) ,但最后我丟失了我的 excel 中的所有格式。 我使用下一個代碼從一個范圍發送和電子郵件到 Outlook
Sub email()
Dim OutApp As Object
Dim OutMail As Object
Dim Fname As String
Dim hoja As String
Dim rng As Range
Dim celdas As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set rng = Range("C3:Q22")
On Error Resume Next
With OutMail
.To = "juan"
.CC = "Maria"
.BCC = ""
.Subject = "XXXX"
.HTMLBody = "Hey" & RangetoHTML(rng)
.Display 'or use .Display
End With
On Error GoTo 0
'Kill Fname
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
和下一個功能,我從下一個鏈接復制如何從 excel 發送郵件
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
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
雖然 OP 接受的答案可能對他有用,但我認為這不是正確的答案。
如果您想從源中保留格式,則需要使用xlPasteAllUsingSourceTheme
代碼:
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
'.Cells(1).PasteSpecial xlPasteValues, , False, False
'.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).PasteSpecial xlPasteAllUsingSourceTheme, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
好的,我在 rangetoHtml() 中找到了如何制作它,粘貼值時我更改了以下代碼:
With TempWB.Sheets(1)
'.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial
'.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
因為如果我只是復制和粘貼,我不會丟失任何格式。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.