2

複数のユーザーが編集するスプレッドシートがあります。以前のデータの改ざんを防ぐために、データが入力されてファイルが保存されると、セルはロックされます。ただし、コードにいくつかの小さなバグがあります。

  1. ユーザーが手動で保存してからアプリケーションを終了しても、再度保存するように求められます。

  2. セルは、終了時だけでなく、アプリケーションの実行中に保存後にロックする必要があります。以前は before_save イベントにこのコードがありましたが、save_as イベントがキャンセルされてもセルがロックされていたため、コードを削除しました。修理済み

（編集：このエラーがいかに明白であるかに気づきました。このステートメントでもそれを言いました！保存前イベントサブを使用して、保存イベント後にセルをロックしようとしています！）

コード

With ActiveSheet
    .Unprotect Password:="oVc0obr02WpXeZGy"
    .Cells.Locked = False
    For Each Cell In ActiveSheet.UsedRange
        If Cell.Value = "" Then
            Cell.Locked = False
        Else
            Cell.Locked = True
        End If
    Next Cell
    .Protect Password:="oVc0obr02WpXeZGy"
End With

ワークブックを開く、すべてのシートを非表示にする、すべてのシートのサブを表示するは、エンド ユーザーにマクロを有効にするよう強制するために使用されます。完全なコードは次のとおりです。

Option Explicit
Const WelcomePage = "Macros"

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim ws As Worksheet
    Dim wsActive As Worksheet
    Dim vFilename As Variant
    Dim bSaved As Boolean

'Turn off screen updating
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

'Record active worksheet
 Set wsActive = ActiveSheet

'Prompt for Save As
If SaveAsUI = True Then
    vFilename = Application.GetSaveAsFilename("", fileFilter:="Excel Files (*.xls), *.xls")
    If CStr(vFilename) = "False" Then
        bSaved = False
    Else
        'Save the workbook using the supplied filename
        Call HideAllSheets
        ThisWorkbook.SaveAs vFilename
        Application.RecentFiles.Add vFilename
        Call ShowAllSheets
        bSaved = True
    End If
Else
    'Save the workbook
    Call HideAllSheets
    ThisWorkbook.Save
    Call ShowAllSheets
    bSaved = True
End If


'Restore file to where user was
wsActive.Activate
'Restore screen updates
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

'Set application states appropriately
If bSaved Then
    ThisWorkbook.Saved = True
    Cancel = True
Else
    Cancel = True
End If

End Sub

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Call ShowAllSheets
    Application.ScreenUpdating = True
    ThisWorkbook.Saved = True
End Sub

Private Sub HideAllSheets()
    Dim ws As Worksheet
    Worksheets(WelcomePage).Visible = xlSheetVisible
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
    Next ws
    Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
    Next ws
    Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

'Lock Cells upon exit save if data has been entered
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Cell As Range
With ActiveSheet
    .Unprotect Password:="oVc0obr02WpXeZGy"
    .Cells.Locked = False
    For Each Cell In ActiveSheet.UsedRange
        If Cell.Value = "" Then
            Cell.Locked = False
        Else
            Cell.Locked = True
        End If
    Next Cell
    .Protect Password:="oVc0obr02WpXeZGy"
End With
End Sub

ありがとう ：）

4

2 に答える 2

1

次の行のために、すでに保存されているにもかかわらず、終了する前に保存するように求めています。

'Save the workbook
Call HideAllSheets
ThisWorkbook.Save
Call ShowAllSheets
bSaved = True

(ShowAllSheets を呼び出して) 保存した後にワークシートを変更しているため、再度保存する必要があります。同じことが saveAs コードにも当てはまります。

于 2012-05-01T14:56:34.637 に答える