1
我已经使用下面的代码实现了一个宏,它创建一个电子邮件将活动工作表发送给某人。Excel中的单个工作表和粘贴值不是公式
它设置了电子邮件没有问题,但一些在复制工作表单元格的不幸内容为“#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 "[email protected]", _
"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并粘贴''拷贝并粘贴'。您可以随时关闭该文件而不必稍后保存。 –