0

セル値が変更されたときに (パスワードを使用して) ワークシートを自動的に保護するマクロを実行しています。このマクロは、開いているすべてのシートで常に実行されます。これはそうあるべきです。しかし、別の Excel ファイルを開くと、そのシートもパスワードで保護されます。マクロが含まれているファイルのみに制限するにはどうすればよいですか?

ありがとう!

Private Sub Worksheet_Calculate()
Dim FormulaRange As Range
Dim FormulaRange2 As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Double

NotSentMsg = "Niet verzonden"
SentMsg = "Verzonden"

'Above the MyLimit value it will run the macro
MyLimit = 0

'Set the range with the Formula that you want to check
Set FormulaRange2 = ActiveSheet.Range("D22")

On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange2.Cells
    With FormulaCell
        If IsNumeric(.Value) = False Then
            MyMsg = "Not numeric"
        Else
            If .Value > MyLimit Then

                MyMsg = SentMsg

                If .Offset(2, 10).Value = NotSentMsg Then
                    Call Mail_with_outlook2
                End If
            Else
                MyMsg = NotSentMsg
            End If
        End If
        Application.EnableEvents = False
ActiveSheet.Unprotect Password:="zou82pam"
        .Offset(2, 10).Value = MyMsg
ActiveSheet.Protect Password:="zou82pam", DrawingObjects:=True, Contents:=True,     
Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
        Application.EnableEvents = True
    End With
Next FormulaCell

ExitMacro:
Exit Sub

EndMacro:
Application.EnableEvents = True

MsgBox "De onderstaande error is ontstaan. Neem contact op met Wouter van Leeuwen" _
     & vbLf & vbLf & Err.Number _
     & vbLf & Err.Description

End Sub
4

1 に答える 1

1

ActiveSheetこれは、バグが発生する可能性があり、可能な限り回避する必要があることを示す完璧な例です。

最初に行う必要があるのは、常に次のオブジェクト階層を尊重することです。

(application) -> workbook -> sheet -> range 

これを VBA に変換すると、常に階層全体を書き留めておくことをお勧めします。

Thisworkbook.Sheets('sheetname').range("A1") 

複数のアプリケーション オブジェクトを使用する場合、または多くの場合ワークブックを使用する場合は、操作するオブジェクトを制御できます。

使用する代わりに:

ActiveSheet.Unprotect Password:="zou82pam"
        .Offset(2, 10).Value = MyMsg
ActiveSheet.Protect Password:="zou82pam", DrawingObjects:=True, Contents:=True,     
Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
        Application.EnableEvents = True
    End With

次のようになります。

Thisworkbook.sheets("somesheet").Unprotect Password:="zou82pam"
        .Offset(2, 10).Value = MyMsg
Thisworkbook.sheets("somesheet").Protect Password:="zou82pam", DrawingObjects:=True, Contents:=True,     
Scenarios:=True
Thisworkbook.sheets("somesheet").EnableSelection = xlUnlockedCells
        Application.EnableEvents = True
    End With

複数のシートをループする必要がある場合は、シート名の代わりにシート インデックスをいつでも使用できます。例えば:

Dim iCnt as integer

for iCnt = 1 to 10
    Thisworkbook.sheets(iCnt).range("A1").value = "this is an example on how to use the sheet index"
next iCnt 
于 2013-10-24T12:48:23.030 に答える