Disable save controls

[rjplante]

I have a workbook file that I have saved with the word "Template" in the title. I have a set of steps the user completes, and then a save macro that will change the name and save the file in the intended file location. I would like to disable all save controls until the save macro runs and then have the last step of the save macro be to call the macro that restores all the save controls. This would be the Ctrl+S, File menu Save and Save As, F12 key, and ribbon and quick access icons. Is there a way to disable all of these functions using the Workbook_Open macro, and then what is the code to restore them all? I would also like to have a message box appear notifying the user that the file cannot be saved unless the save button is used.

 

[rjplante]

Try this link.

SN Test Sheet Template.xlsm

Shared with Dropbox

www.dropbox.com

 

[Mentor82]

Hi,
Thanks a lot that you uploaded your file.
I've checked your code and made changes to the two following methods: DOC_SAVE_AS and CREATE_SHORTCUT. Here I enclose the changes I've made. Paste them into your workbook and it should work now. There are comments inside of what I've changed.

Here are changes to the DOC_SAVE_AS

'SNTI: Method Adjusted
Sub DOC_SAVE_AS()

'   Enables the 'Save' controls
    Sheets("Intro Page").Range("AA15").Value = "Enabled"
    SaveAUI = True

Application.ScreenUpdating = False
    
Dim Fname As String
Dim Fpath As String
Dim FSaveName As String
'Dim ValidPath As String

Fname = Sheets("Intro Page").Range("AA1").Value
Fpath = Sheets("Intro Page").Range("B20").Value
FSaveName = Fpath + Fname

If Sheets("Intro Page").Range("B20").Value = "" Then
    MsgBox "A save location has not been selected." & vbCrLf & "Select a folder before proceeding." & vbCrLf & vbCrLf & _
    "When The field next to File Path is filled, select the Disk icon again"
    
    Application.ScreenUpdating = True
    Call GetFolder_QC_sheets
        
Else
    Application.DisplayAlerts = False 'SNTI: Change - set application display alerts in order to override existing file withou asking user
    ActiveWorkbook.SaveAs Filename:=FSaveName, FileFormat:=52
    MsgBox "The file has been saved as: " & Fname & vbCrLf & _
            "In this location: " & Fpath
    Application.DisplayAlerts = True 'SNTI: Turn on back the application alerts

    Sheets("Electrical - Panel Assembly").Visible = True
    Sheets("Corrections").Visible = True
    Sheets("Intro Page").Activate
    
    Application.ScreenUpdating = True
End If

Call CREATE_SHORTCUT

Application.ScreenUpdating = True

End Sub

Here are changes to CREATE_SHORTCUT

'SNTI: Method adjusted
Sub CREATE_SHORTCUT()

Dim DTPath As String
Dim oWSH As Object
Dim oShortcut As Object
Dim sPathDeskTop As String
Dim MyFile$


DTPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Active Jobs\"

'SNTI: Change
If Not (Len(Dir(DTPath, vbDirectory)) > 0) Then MkDir DTPath

MyFile = DTPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name))

Set oWSH = CreateObject("WScript.Shell")

'Set oShortcut = oWSH.CreateShortCut(DTPath & "\" & _
'ActiveWorkbook.Name & ".lnk")
Set oShortcut = oWSH.CreateShortCut(MyFile & ".lnk")
'SNTI://end

With oShortcut
.TargetPath = ActiveWorkbook.FullName
.Save
End With
Set oWSH = Nothing


End Sub

 

[Mentor82]

Hi, have you tried the code for thread #12. Is that what you need?

 

[rjplante]

I have implemented the updates to the code and no issues so far. Thanks for the help. Sorry I didn't respond sooner, it took me a while to get back to that project.