我复制了一个 Excel sheet 的副本，它关闭了自动计算，然后是 copy/paste 值，但自动计算在粘贴值之前打开
I make a copy of an Excel sheet that has Automatic calculate turned off, then copy/paste values but auto calc turns on before the paste values
我有一个点差sheet，一旦通过电子邮件发送，它的自动计算就变成了手动计算。我不使用保护 sheet，因为如果数据源在邮件后更新，公式仍会更新。
在极少数情况下，可能需要将其他 sheet 提供的更改再次邮寄给 sheet。那时我有代码复制 sheet，然后复制并粘贴为值，留下原始 sheet 加入大头钉成为版本 II.
我尽量避免在发送邮件时执行 copy/paste 值，因为如果不需要的话，我想避免在工作簿中有两份 sheet。
问题是，即使在复制 sheet 时自动更新已关闭，但在我能够复制和过去的值之前它似乎已关闭。
有谁知道如何在将数据粘贴为值之前停止将数据输入 sheet 上的公式？
更新以添加代码。
关闭自动计算的代码
Sub Turn_AutoUpdate_OFF()
' ***** STOPS alutomatic formular updating
' x - Defined Cell Names Lock_LABEL
' x - Image Lock_ON Lock_OFF
Application.ScreenUpdating = False ' do not see screen updating
If ActiveSheet.Name = "4_Transport" Then
' Make ON lock Small
ActiveSheet.Shapes.Range(Array("Lock_ONN")).Select ' x
Selection.ShapeRange.Height = 28.3464566929
' Make OFF lock Big
ActiveSheet.Shapes.Range(Array("Lock_OFF")).Select ' x
Selection.ShapeRange.Height = 46.7716535433
' Label
Range("TLock_LABEL").Select ' x
ActiveCell.FormulaR1C1 = "Auto Update is OFF"
Selection.HorizontalAlignment = xlLeft
With ActiveCell.Characters(Start:=15, Length:=4).Font
.FontStyle = "Fett"
.Size = 10
.Color = -16776961
End With
Range("B1").Select
' Turn automatic folular updating OFF
ActiveSheet.EnableCalculation = False
ElseIf ActiveSheet.Name = "5_Angebot" Then
' Make ON lock Small
ActiveSheet.Shapes.Range(Array("Lock_ONN")).Select ' x
Selection.ShapeRange.Height = 28.3464566929
' Make OFF lock Big
ActiveSheet.Shapes.Range(Array("Lock_OFF")).Select ' x
Selection.ShapeRange.Height = 46.7716535433
' Label
Range("ANLock_LABEL").Select ' x
ActiveCell.FormulaR1C1 = "Auto Update is OFF"
Selection.HorizontalAlignment = xlLeft
With ActiveCell.Characters(Start:=15, Length:=4).Font
.FontStyle = "Fett"
.Size = 10
.Color = -16776961
End With
Range("B1").Select
' Turn automatic folular updating OFF
ActiveSheet.EnableCalculation = False
Range("B1").Select
End If
Application.ScreenUpdating = True ' see screen updating
End Sub
然后复制以创建 sheet Angebot 的副本（工作机会成本）
Sub New_Angebot_II()
' ***** Creates copy of sheet 5_Angebot *****
' x Defined Cell Names - ANVersion , ANReplaced
Dim fs As Worksheet
Dim es As Worksheet
Dim ns As Worksheet
Set fs = Sheets("5_Angebot") ' From WorkSheet
Set es = Sheets("4_Data Form") ' End on WorkSheet
' ns = Sheets("5_Angebot I") ' New WorkSheet - oooo
Application.ScreenUpdating = False ' do not see screen updating
' Check if the current Angebot is the first (I)
fs.Select
If Range("ANVersion").Value <> "I" Then ' x
MsgBox " Check if Angebot II has already been created " & vbNewLine & _
" Choose option to Create Angebot III", , "Check if Angebot II already exists"
es.Select
Exit Sub
End If
' Give User a opportunity to stop Copy
If MsgBox(" Angebot I will have its values fixed" & vbNewLine & _
" and be renamed as Anbebot II" & vbNewLine & vbNewLine & _
" Are you sure you want to create a New Angebot…?", vbQuestion + vbYesNo) <> vbYes Then
es.Select
Exit Sub
End If
' Select & Copy 5_Angebot
fs.Copy Before:=fs
' Change all formulars to fixed values
ActiveSheet.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False ' empties the clipboard and clears the memory cache
Range("B1").Select
' Rename sheet as old Angebot
ActiveSheet.Name = Replace$(ActiveSheet.Name, "(2)", "I")
Set ns = ActiveSheet ' New WorkSheet - oooo
Range("B1").Select
' Remove all the macro Buttons and shapes
'Dim i As Integer
If ActiveSheet.ProtectContents = True Then
MsgBox "The Current Workbook or the Worksheets which it contains are protected." & vbLf & _
" Please resolve these issues and try again."
End If
On Error Resume Next
ActiveSheet.Buttons.Delete
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
Shp.Delete
Next Shp
' Protect sheet from updates
' Label
Range("A4").Select ' x
ActiveCell.FormulaR1C1 = "LOCK is ON"
Selection.HorizontalAlignment = xlRight
With ActiveCell.Characters(Start:=9, Length:=2).Font
.FontStyle = "Fett"
.Size = 10
.Color = -16776961
End With
Range("B1").Select
' PROTECT
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Go to 5_Angebot change Heading to II
fs.Select
Range("ANVersion").Select ' x
ActiveCell.FormulaR1C1 = "II"
Range("B1").Select
' Remove EMAILED Heading
Range("ANEmailed").Select ' x
ActiveCell.FormulaR1C1 = ""
Range("ANEmailDate").Select ' x
ActiveCell.FormulaR1C1 = ""
Range("B1").Select
' Turn Automatic update ON
Call Turn_AutoUpdate_ONN
' Go Back to 4_Data Form
es.Select
Range("B1").Select
Application.ScreenUpdating = True ' see screen updating
End Sub
当您复制工作表时，Worksheet.EnableCalculation 属性 不会被复制，也不会保存在已保存的工作簿中。如果您需要在 worksheet.copy 之后或工作簿的电子邮件之后将其设置为 False，则您的代码需要在复制后以及每次打开工作簿时将其重置。
我有一个点差sheet，一旦通过电子邮件发送，它的自动计算就变成了手动计算。我不使用保护 sheet，因为如果数据源在邮件后更新，公式仍会更新。
在极少数情况下，可能需要将其他 sheet 提供的更改再次邮寄给 sheet。那时我有代码复制 sheet，然后复制并粘贴为值，留下原始 sheet 加入大头钉成为版本 II.
我尽量避免在发送邮件时执行 copy/paste 值，因为如果不需要的话，我想避免在工作簿中有两份 sheet。
问题是，即使在复制 sheet 时自动更新已关闭，但在我能够复制和过去的值之前它似乎已关闭。
有谁知道如何在将数据粘贴为值之前停止将数据输入 sheet 上的公式？
更新以添加代码。
关闭自动计算的代码
Sub Turn_AutoUpdate_OFF()
' ***** STOPS alutomatic formular updating
' x - Defined Cell Names Lock_LABEL
' x - Image Lock_ON Lock_OFF
Application.ScreenUpdating = False ' do not see screen updating
If ActiveSheet.Name = "4_Transport" Then
' Make ON lock Small
ActiveSheet.Shapes.Range(Array("Lock_ONN")).Select ' x
Selection.ShapeRange.Height = 28.3464566929
' Make OFF lock Big
ActiveSheet.Shapes.Range(Array("Lock_OFF")).Select ' x
Selection.ShapeRange.Height = 46.7716535433
' Label
Range("TLock_LABEL").Select ' x
ActiveCell.FormulaR1C1 = "Auto Update is OFF"
Selection.HorizontalAlignment = xlLeft
With ActiveCell.Characters(Start:=15, Length:=4).Font
.FontStyle = "Fett"
.Size = 10
.Color = -16776961
End With
Range("B1").Select
' Turn automatic folular updating OFF
ActiveSheet.EnableCalculation = False
ElseIf ActiveSheet.Name = "5_Angebot" Then
' Make ON lock Small
ActiveSheet.Shapes.Range(Array("Lock_ONN")).Select ' x
Selection.ShapeRange.Height = 28.3464566929
' Make OFF lock Big
ActiveSheet.Shapes.Range(Array("Lock_OFF")).Select ' x
Selection.ShapeRange.Height = 46.7716535433
' Label
Range("ANLock_LABEL").Select ' x
ActiveCell.FormulaR1C1 = "Auto Update is OFF"
Selection.HorizontalAlignment = xlLeft
With ActiveCell.Characters(Start:=15, Length:=4).Font
.FontStyle = "Fett"
.Size = 10
.Color = -16776961
End With
Range("B1").Select
' Turn automatic folular updating OFF
ActiveSheet.EnableCalculation = False
Range("B1").Select
End If
Application.ScreenUpdating = True ' see screen updating
End Sub
然后复制以创建 sheet Angebot 的副本（工作机会成本）
Sub New_Angebot_II()
' ***** Creates copy of sheet 5_Angebot *****
' x Defined Cell Names - ANVersion , ANReplaced
Dim fs As Worksheet
Dim es As Worksheet
Dim ns As Worksheet
Set fs = Sheets("5_Angebot") ' From WorkSheet
Set es = Sheets("4_Data Form") ' End on WorkSheet
' ns = Sheets("5_Angebot I") ' New WorkSheet - oooo
Application.ScreenUpdating = False ' do not see screen updating
' Check if the current Angebot is the first (I)
fs.Select
If Range("ANVersion").Value <> "I" Then ' x
MsgBox " Check if Angebot II has already been created " & vbNewLine & _
" Choose option to Create Angebot III", , "Check if Angebot II already exists"
es.Select
Exit Sub
End If
' Give User a opportunity to stop Copy
If MsgBox(" Angebot I will have its values fixed" & vbNewLine & _
" and be renamed as Anbebot II" & vbNewLine & vbNewLine & _
" Are you sure you want to create a New Angebot…?", vbQuestion + vbYesNo) <> vbYes Then
es.Select
Exit Sub
End If
' Select & Copy 5_Angebot
fs.Copy Before:=fs
' Change all formulars to fixed values
ActiveSheet.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False ' empties the clipboard and clears the memory cache
Range("B1").Select
' Rename sheet as old Angebot
ActiveSheet.Name = Replace$(ActiveSheet.Name, "(2)", "I")
Set ns = ActiveSheet ' New WorkSheet - oooo
Range("B1").Select
' Remove all the macro Buttons and shapes
'Dim i As Integer
If ActiveSheet.ProtectContents = True Then
MsgBox "The Current Workbook or the Worksheets which it contains are protected." & vbLf & _
" Please resolve these issues and try again."
End If
On Error Resume Next
ActiveSheet.Buttons.Delete
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
Shp.Delete
Next Shp
' Protect sheet from updates
' Label
Range("A4").Select ' x
ActiveCell.FormulaR1C1 = "LOCK is ON"
Selection.HorizontalAlignment = xlRight
With ActiveCell.Characters(Start:=9, Length:=2).Font
.FontStyle = "Fett"
.Size = 10
.Color = -16776961
End With
Range("B1").Select
' PROTECT
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Go to 5_Angebot change Heading to II
fs.Select
Range("ANVersion").Select ' x
ActiveCell.FormulaR1C1 = "II"
Range("B1").Select
' Remove EMAILED Heading
Range("ANEmailed").Select ' x
ActiveCell.FormulaR1C1 = ""
Range("ANEmailDate").Select ' x
ActiveCell.FormulaR1C1 = ""
Range("B1").Select
' Turn Automatic update ON
Call Turn_AutoUpdate_ONN
' Go Back to 4_Data Form
es.Select
Range("B1").Select
Application.ScreenUpdating = True ' see screen updating
End Sub
当您复制工作表时，Worksheet.EnableCalculation 属性 不会被复制，也不会保存在已保存的工作簿中。如果您需要在 worksheet.copy 之后或工作簿的电子邮件之后将其设置为 False，则您的代码需要在复制后以及每次打开工作簿时将其重置。