VBA Unprotect not working - sometimes

mark hansen

Active Member
Joined
Mar 6, 2006
Messages
473
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)

Code:
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.

Code:
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
Code:
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

Code:
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

Active Member
Joined
Mar 6, 2006
Messages
473
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

New Member
Joined
Jul 31, 2018
Messages
1
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?
 

Forum statistics

Threads
1,081,969
Messages
5,362,484
Members
400,677
Latest member
champchamp

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top