0

電子メールで送信された後、自動計算が手動に変わったスプレッドシートがあります。メールに続いてデータソースが更新された場合でも数式が更新されるため、保護シートは使用しません。

まれに、他のシートからフィードされた変更を含むシートを再度郵送する必要がある場合があります。その時点で、シートのコピーを作成し、値としてコピーして貼り付けて、元のシートをそのままにしてバージョン II にするコードがあります。

必要がない場合はワークブックにシートのコピーを 2 つ入れないようにしたいので、メール時にコピー/貼り付けの値を実行しないようにしています。

問題は、シートがコピーされたときに自動更新がオフになっているにもかかわらず、値をコピーして貼り付ける前にオフになっているように見えることです。

値として貼り付ける前に、シート上の数式へのデータフィードを停止する方法を知っている人はいますか?

コードを追加するための更新。

自動計算をオフにするコード

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

続いて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
4

1 に答える 1

1

Worksheet.EnableCalculation プロパティは、ワークシートをコピーしてもコピーされず、保存されたブックにも保存されません。worksheet.copy の後またはワークブックの電子メールの後に False にする必要がある場合は、コピー後およびワークブックを開くたびにコードをリセットする必要があります。

于 2015-04-27T07:18:33.257 に答える