如何修改VBA代码保留Excel工作表时间格式（如16:00:00）

嘿，这个问题我太熟悉了——你遇到的时间格式变成小数的情况，根源就在代码里的这一段：

With wb.Sheets(1).UsedRange
    .Cells.Copy
    .Cells.PasteSpecial xlPasteValues
End With

Excel里的时间本质是日期序列号的小数部分（比如16:00:00对应的就是0.666666667），你看到的“16:00:00”只是单元格的显示格式。当你只粘贴值的时候，格式信息就丢失了，接收方看到的就是原始的小数数值。

怎么修改？ #

把单纯粘贴值的操作，改成同时粘贴值和数字格式——这样既能把公式转成静态值（这应该是你原来用xlPasteValues的目的），又能保留时间的显示格式。

只需要把粘贴的枚举值换成xlPasteValuesAndNumberFormats就行，修改后的核心片段：

With wb.Sheets(1).UsedRange
    .Cells.Copy
    ' 替换原来的xlPasteValues，同时保留值和数字格式
    .Cells.PasteSpecial xlPasteValuesAndNumberFormats
End With

完整的修改后代码 #

Option Explicit
Sub Mail_Every_Worksheet()
    'Working in Excel 2000-2016
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
        'Excel 97-2003 兼容
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'Excel 2007+
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set OutApp = CreateObject("Outlook.Application")

    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("A1").Value Like "?*@?*.?*" Then
            sh.Copy
            Set wb = ActiveWorkbook

            ' 转换为静态值并保留数字格式（包括时间）
            With wb.Sheets(1).UsedRange
                .Cells.Copy
                .Cells.PasteSpecial xlPasteValuesAndNumberFormats
            End With
            Application.CutCopyMode = False

            TempFileName = "Sheet " & sh.Name & " of " _
                          & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

            Set OutMail = OutApp.CreateItem(0)

            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
                On Error Resume Next
                With OutMail
                    .To = sh.Range("A1").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "TEST"
                    .Body = "Hi there"
                    .Attachments.Add wb.FullName
                    ' 可以在这里添加其他附件
                    '.Attachments.Add ("C:\test.txt")
                    .Send ' 换成.Display可以先预览邮件再发送
                End With
                On Error GoTo 0
                .Close savechanges:=False
            End With

            Set OutMail = Nothing
            Kill TempFilePath & TempFileName & FileExtStr
        End If
    Next sh

    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

额外提示 #

• 如果需要兼容Excel 2003版本，xlPasteValuesAndNumberFormats对应的数值是12，可以写成.Cells.PasteSpecial 12（因为2003没有这个枚举名）。
• 这个修改不仅能保留时间格式，所有数字相关的格式（比如货币、百分比、自定义数字格式）都会被保留下来，完全符合你的需求。

内容的提问来源于stack exchange，提问作者Stephen