VBA Unprotect not working - sometimes

[mark hansen]

I'm having some problems with the .Unprotect code not working as I expect. Here's what's going on.

I have a workbook that when it closes, it saves two JPG images of a portion of the spreadsheet to use on a status board (via screen saver). To do this I found a bit of code that creates a Chart of the area, and exports the chart as a JPG. I've been using it for years and works well. As part of that routine, I unprotect the sheet to create the chart, then protect the sheet again at the end. It all works fine. I have this routine on a button so the user can create the JPG images anytime they want.

I also call this routine during the Private Sub Workbook_BeforeClose event so if the user forgets to save the update to the status board, it will happen automatically when the workbook closes. That part works fine as well. (The routine is called PublishSchedule)

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call PublishSchedule
    Call WritePDF
    Worksheets("Data").Range("2:5000").ClearContents
    Worksheets("Opening Sheet").Activate
    Call Disable
    Log_Action (",Close,")
    ThisWorkbook.Save
    ActiveWorkbook.Saved = True
end sub

Based on a new customer requirements they want the workbook to save and close if no action is taken within 15 min... OK, I did that without problems with a bit of code I found on the internet. I made modifications to save and close the workbook if the user forgets they have the workbook open.

The problem is the Publish schedule routine doesn't unprotect the worksheet when in the close event (ONLY WHEN the close is started from the shutdown routine.) This causes errors when it takes the steps to create a chart to save a jpg. When stepping through the code, I notice the worksheet doesn't unprotect when I step though the WS.Unprotect line.

Sub PublishSchedule()
    'publish as 2 JPG files to display in SharePoint and in the screen saver
    Dim ws, Con As Worksheet
    Dim lrow
    Dim FullFileName, JPGFullFileName As String
    Dim PDFName, sDate As String
    Dim Path, Shift, JPGPath As String
   
    On Error GoTo ErrHandler
    Application.EnableEvents = False
   
    Set Con = Worksheets("Configuration")
    Set ws = Worksheets("Main 1")
    
    ws.Unprotect
    ws.Activate
   
    Application.Calculate
    PleaseWaitFrm.Show vbModeless
    PleaseWaitFrm.Label1.Caption = "Creating necessary files"
    PleaseWaitFrm.Repaint
    '=======Set up JPG=================================================
    JPGFullFileName = Con.Range("AB27").Value
    If Right(JPGFullFileName, 1) <> "\" Then JPGFullFileName = JPGFullFileName & "\"
   
    JPGFullFileName = JPGFullFileName & Con.Range("AB26").Value & ".jpg"
 
    Dim rgExp As Range: Set rgExp = ws.Range("C1:AA46") 'place range here
    rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
   
    With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
        Width:=rgExp.Width, Height:=rgExp.Height)
        .Name = "ChartVolumeMetricsDevEXPORT"
        .Activate
    End With
  
    ActiveChart.Paste
    '================================================================================
    ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export JPGFullFileName, Filtername:="jpg"
    ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete
    '================================================================================
    
    '==========Second Picture==================================================================
    Application.Calculate
    Application.EnableEvents = False
    '=============================================
    Range("M4").Value = "."  'set difference in second picture
    '=============================================
    JPGFullFileName = Con.Range("AB27").Value
    If Right(JPGFullFileName, 1) <> "\" Then JPGFullFileName = JPGFullFileName & "\"
    JPGFullFileName = JPGFullFileName & Con.Range("AB26").Value & "2.jpg"  'Set File name for second jpg file
   
    rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
   
    With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
        Width:=rgExp.Width, Height:=rgExp.Height)
        .Name = "ChartVolumeMetricsDevEXPORT"
        .Activate
    End With
    ActiveChart.Paste
    '================================================================================
    ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export JPGFullFileName, Filtername:="jpg"
    ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete
    '===================================================================================
    Range("M4").Value = ""   'Remove difference in second picture
    ActiveSheet.Protect
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True
    ActiveSheet.EnableSelection = xlUnlockedCells
    
    Application.EnableEvents = True
    Unload PleaseWaitFrm
Exit Sub

ErrHandler:
    Application.EnableEvents = True
    Call CheckError
End Sub

Here is the code that starts the shutdown.

This code is in a module

Dim DownTime As Date

 Sub SetTime()
 DownTime = Now + TimeValue("00:15:00")
 Application.OnTime DownTime, "ShutDown"
 End Sub


 Sub ShutDown()
    'Sheet5.Activate
    'Sheet5.Unprotect
    ThisWorkbook.Save
    ThisWorkbook.Close
 End Sub

 Sub Disable()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, Procedure:="ShutDown", _
    Schedule:=False
 End Sub

This code is in the "Thisworkbook" module

Private Sub Workbook_Open()
Application.EnableEvents = False
Call PullCSVData
Worksheets("Main 1").Activate
'========================
'Range("K2").Select
'CalendarFrm.Show
ShiftFrm.Show
Range("U5").Select
Application.EnableEvents = True
'==========================
Call SetTime
Log_Action (",Open,")
End Sub

(Of course the only part the shut down needs if the "Call SetTime line"

Why does the unprotect work fine when the PublishSchedule is called on its own (via a button) and when the "Before close" event start when the user closes the workbook. But when the "Beforeclose" event is started by the " Sub ShutDown()" routine, it doesn't unprotect. As you can see I've tried to put in the Unprotect ahead of the routine (Sheet5) is the sheet for the status board). I've also referred to it by the name (Worksheets("Main 1").unprotect and it does work either. I've also put the unprotect in the beforeclose event, before calling the PublishSchedule routine - NoGo.

Thanks for any insight on what I'm doing wrong.

Mark

 

[mark hansen]

I guess another way to state the problem is .... Is there anything with the Application.OnTime function that affects other functions like worksheet Unprotect? I've been poking around the internet and haven't come up with anything yet.

 

[MsAgentM]

Hi Mark, I am having the exact same problem. My program just skips right over the WS.Unprotect when I run the macro but not when I save using the Excel save. Were you ever able to correct the issue?