Blocco delle Celle dopo l’Inserimento dei Dati

Ho un foglio di calcolo che è in cura da più utenti. Per evitare la manomissione di dati precedente le celle sono bloccate i dati una volta che è stato inserito e salvato il file. Ho un paio di piccoli bug nel codice, però:

  1. Anche se l’utente ha salvato manualmente e poi esce dall’applicazione sono ancora richiesto di salvare di nuovo.

  2. Le cellule dovrebbe essere bloccato dopo un salvataggio quando l’applicazione è in esecuzione e non solo quando è uscito. In precedenza ho avuto questo codice before_save evento, ma le cellule venivano bloccate anche se un save_as evento è stata annullata, quindi ho rimosso il codice per ora. Fisso

(Edit: ho appena capito come ovvio che questo errore. Ho anche detto che in questa affermazione! Il tentativo di blocco delle cellule dopo il salvataggio di un evento mediante una prima salva l’evento sub! )

Codice

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

La cartella di lavoro aperta, nascondere tutti i fogli e mostra tutti i fogli sub sono utilizzati per costringere l’utente ad attivare le macro. Ecco il codice completo:

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

Grazie 🙂

InformationsquelleAutor Alistair Weir | 2012-05-01



2 Replies
  1. 1

    Si sta chiedendo loro di salvare prima di uscire, anche se hanno già salvato a causa di queste linee:

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

    Si sta modificando il foglio di lavoro dopo il salvataggio (chiamando ShowAllSheets) quindi non ha bisogno di essere salvato di nuovo. Lo stesso vale per il salva con nome codice.

  2. 0

    Ho risolto il secondo problema utilizzando un altro SE. Questo assicura che le cellule sono solo bloccato se i dati sono salvati:

    'Lock Cells before save if data has been entered
        Dim rpcell As Range
    With ActiveSheet
        If bSaved = True Then
        .Unprotect Password:="oVc0obr02WpXeZGy"
        .Cells.Locked = False
        For Each rpcell In ActiveSheet.UsedRange
            If rpcell.Value = "" Then
                rpcell.Locked = False
            Else
                rpcell.Locked = True
            End If
        Next rpcell
        .Protect Password:="oVc0obr02WpXeZGy"
        Else
        MsgBox "The LogBook was not saved. You are free to edit the RP Log again", vbOKOnly, "LogBook Not Saved"
        End If
    End With

Lascia un commento