在 Excel 中通过电子邮件发送单个工作表并粘贴值而不是公式答案

【问题标题】：Email Single Worksheet in Excel and Paste Values Not Formulae在 Excel 中通过电子邮件发送单个工作表并粘贴值而不是公式
【发布时间】：2023-03-30 01:39:02
【问题描述】：

我使用下面的代码实现了一个宏，它创建了一封电子邮件以将活动工作表发送给某人。

来源：http://msdn.microsoft.com/en-us/library/bb268022(v=office.12).aspx#Excel2007DifferentWaysEmail_SendingaSingleWorksheetbyEMail

它设置电子邮件没有问题，但不幸的是，复制的工作表中某些单元格的内容是“#REF”，而不是原始单元格中包含的内容。不过，这只发生在某些细胞上，我不知道为什么。原来空白的单元格在新工作表中总是得到“#REF”

Sub Mail_ActiveSheet()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String

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

Set Sourcewb = ActiveWorkbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

With Destwb
If Val(Application.Version) < 12 Then
  ' You are using Excel 97-2003.
  FileExtStr = ".xls": FileFormatNum = -4143
Else
  If Sourcewb.Name = .Name Then
     With Application
        .ScreenUpdating = True
        .EnableEvents = True
     End With
     MsgBox "Your answer is No in the security dialog."
     Exit Sub
  Else
     Select Case Sourcewb.FileFormat
        ' Code 51 represents the enumeration for a macro-free
        ' Excel 2007 Workbook (.xlsx).
        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
        ' Code 52 represents the enumeration for a 
        ' macro-enabled Excel 2007 Workbook (.xlsm).
        Case 52:
           If .HasVBProject Then
              FileExtStr = ".xlsm": FileFormatNum = 52
           Else
              FileExtStr = ".xlsx": FileFormatNum = 51
           End If
        ' Code 56 represents the enumeration for a 
        ' a legacy Excel 97-2003 Workbook (.xls).
        Case 56: FileExtStr = ".xls": FileFormatNum = 56
        ' Code 50 represents the enumeration for a 
        ' binary Excel 2007 Workbook (.xlsb).
         Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
     End Select
  End If
End If
End With

' Change all cells in the worksheet to values, if desired.
With Destwb.Sheets(1).UsedRange
  .Cells.Copy
  .Cells.PasteSpecial xlPasteValues
  .Cells(1).Select
End With
Application.CutCopyMode = False

'Save the new workbook and then mail it.
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
  On Error Resume Next
  For I = 1 To 3
     .SendMail "insert@emailhere", _
        "This is the Subject line"
        If Err.Number = 0 Then Exit For
  Next I
  On Error GoTo 0
.Close SaveChanges:=False
End With

' Delete the file you just sent.
Kill TempFilePath & TempFileName & FileExtStr

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

【问题讨论】：

在黑暗中拍摄。在执行ActiveSheet.Copy 之前，不要执行Destwb.Sheets(1).UsedRange.Cells.Copy and paste，而是执行.Copy and paste。您可以随时关闭该文件而无需稍后保存。

标签： excel vba email excel-2007

【解决方案1】：

手动将工作表复制到新工作簿会导致同样的问题。我在 Set Sourcewb = ActiveWorkbook 之前用以下代码修复了它

Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

然后在 TempFileName = ....

Sourcewb.Close SaveChanges:=False

【讨论】：