2013-12-12 66 views
1

我已经使用下面的代码实现了一个宏,它创建一个电子邮件将活动工作表发送给某人。Excel中的单个工作表和粘贴值不是公式

来源: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 "[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 
+0

在黑暗中拍摄固定它。在执行'ActiveSheet.Copy'之前,不要使用'Destwb.Sheets(1).UsedRange.Cells.Copy并粘贴''拷贝并粘贴'。您可以随时关闭该文件而不必稍后保存。 –

回答

0

手动将工作表复制到新的工作簿引起同样的问题。我设置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 
相关问题