Disabling functions in excel

Sharid

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,066
Office Version
  1. 2016
Platform
  1. Windows
I wrote this code below to show the full screen in excel, (no tool bars showing) I also want to disable all the commands on the top command menu bar apart from the dropdowns in the file option.

i.e. all the commands from Edit to Help are disabled apart from the File option. on exit of excel I want them to be enabled.

Also not sure if this is possible but is there a way to disable the Close option in the file drop down menu, leaving the user with the option to click Exit. As Exit will close excel were as the close option allows the user to close the workbook. On exit every thing is enabled.

And my final request, the X in the top right hand corner is there a way to disable it and on exit of excel enable it?



Private Sub Workbook_Activate()
Application.DisplayFullScreen = True
Application.CommandBars("Full Screen").Visible = False
UserForm1.Show
End Sub



Private Sub Workbook_Deactivate()
Application.DisplayFullScreen = False
End Sub
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Sort by date Sort by votes
Sounds like you are trying to build a Dictator Application.

The first question is: "What version of Excel are you working in?"

Related to the first question is also the question of whether you will possibly be suporting multiple versions of Excel.

These questions are important because 2003 and 2007 handle some of these issues very differently (though there is some overlap).
 
Upvote 0
At home it is excel 2003, but at work it is 2000 or 2002. So I would need it for 2000 or 2002. I have built stuff at home before and taken them into work and they have not worked.

I need it for work
 
Upvote 0
The basic structure of 2000 through 2003 is consistant enough that the code should work across both platforms. But I can't promise anything.

I can share with you the code I used for the dictator application I built for 2003. It locks Excel down to the point that a user doesn't even know he's in Excel (othe rthan the fact that he opened a .xls file in the first place). It will up to you to decide what components to omit or include, however.

Most of the concepts and a good deal of the code came from 1st Edition Professional Excel Developement (PED) by Bullen Bovey and Green.

I'll try to get the code portions posted here over the course of the morning. It'll take me a few posts to get it all in, and I will try to cull the code to make it as generic as possible, but please understand that it may take me a couple of hours between my real job responsibilities to get it all out there for you. My apologies at the lack of comments... I'll try to give some narrative along the way.
 
Upvote 0
thanks for taking the time out to have a look and giv it a shot, any help is welcomed
 
Upvote 0
Hatman, I think I have all most cracked one first half of my problem. I have amended the code I previous posted. I can now disable the Command Menu Options and enable them on exit.

The problem I have now is that it disables all the Menu commands; this includes File to Help, and Not Edit to Help. As I wanted, could you have looks to see were I am going wrong.

I placed both codes in the Thisworkbook

On opening the workbook this disable all the menu commands and shows full screen (no tool bars)

Private Sub Workbook_Activate()
Application.DisplayFullScreen = True
Application.CommandBars("Full Screen").Visible = False
UserForm1.Show
Dim combarControl As CommandBarControl
For Each combarControl In Application.CommandBars("Worksheet Menu Bar").Controls

combarControl.Enabled = False

Next combarControl
End Sub

(On exit this code enable the menu commands and also shows the tools)

Private Sub Workbook_Deactivate()
Application.DisplayFullScreen = False
Dim combarControl As CommandBarControl
For Each combarControl In Application.CommandBars("Worksheet Menu Bar").Controls

combarControl.Enabled = True

Next combarControl
End Sub

Still need help in disabling the x in the top right hand corner of excel and the close option in the file menu.

cheers
 
Upvote 0
Your scope is much larger than you think. To go down this road, you also need to prevent the user from pressing Ctrl + Q.

Further, you will want to prevent the user from right-clicking the menu bar area, and simply re-enabling the menus your code turns off.

All of these issues are covered in the code I will post.

The code actually replaces the WorkSheet Menu with a Custom Menu that then links to other subroutines, including one to close the application. Since the code to build teh custom menu is from PED, I can't post that code, so I'm putting a close command in a custom CommandBar instead.
 
Upvote 0
Okay, this code will behave a little differently depending upon whether the workbook is readonly or not. If it is NOT readonly, the workbook will be saved automatically on exit. If it IS readonly, it will automatically discard changes on exit. Adjust the code as required.

This code also disables ALL shortcut keys, as well as the function keys. You can remove this or set these keystrokes to run whatever subroutines you want...

I have included the SetIcon subroutine, to set the window icon to a bitmap image. Please either disable the call, or set the pathname to something valid on your system/network before executing.

Okay. This code goes in the ThisWorkbook Class Module:

Code: 
Private Sub Workbook_Open()
    Dim App As Excel.Application
    
    If Application.Workbooks.Count > 1 And ThisWorkbook.ReadOnly = True Then
    
        Close_Flag = True
        
        Set App = New Excel.Application
        
        App.Workbooks.Open (ThisWorkbook.FullName)
        
        App.Visible = True
        
        Set App = Nothing
        
        ThisWorkbook.Saved = True
        
        ThisWorkbook.Close
        
    End If
    
    Call Build_ToolBar
    
    Call Hamstring_On
    
    Call SetExcelIcon
    
       
End Sub
  
Private Sub Workbook_BeforeClose(Cancel As Boolean)
   
    If Not Close_Flag Then
    
        Cancel = True
        
        MsgBox "Please select EXIT from the File Menu.", vbCritical, "Cannot Close"
        
    End If
    
End Sub

And this code goes in a standard code module:
Code: 
Global Const App_Name As String = "Custom_App"
Global Const Sect2 As String = "Settings"
Global Const WM_SETICON = &H80
Global Close_Flag As Boolean

Public Declare Function FindWindow _
    Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Public Declare Function ExtractIcon _
    Lib "shell32.dll" Alias "ExtractIconA" _
    (ByVal hInst As Long, _
    ByVal lpszExeFileName As String, _
    ByVal nIconIndex As Long) As Long
Public Declare Function SendMessage _
    Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Integer, _
    ByVal lParam As Long) As Long
    
Public Declare Function SetForegroundWindow _
    Lib "user32" _
    (ByVal hwnd As Long) As Long
    
Sub SetExcelIcon()
    Dim lngXLHwnd As Long, lngIcon As Long, strIconPath As String
    
    
    'Change this to a valid icon path on your network/drive
    strIconPath = "U:\proceng\wip\test_procs\wpoga\oga\Administration\PES Stuff\Data\SpaceStation.bmp"
    lngXLHwnd = FindWindow("XLMAIN", Application.Caption)
    
    lngIcon = ExtractIcon(0, strIconPath, 0)
    
    SendMessage lngXLHwnd, WM_SETICON, False, lngIcon
End Sub
Sub Build_ToolBar()
    Dim MyBar As CommandBar
    
    On Error Resume Next
    
    Application.CommandBars("MAIN_BAR").Delete
    
    On Error GoTo 0
    
    
    Set MyBar = Application.CommandBars.Add(Name:="MAIN_BAR", Position:=msoBarTop)
    
    With MyBar
    
        .Controls.Add Type:=msoControlButton, Before:=1
        .Controls(1).Caption = "Unlock App"
        .Controls(1).OnAction = "Admin_Access"
        .Controls(1).FaceId = 260
    
        .Controls.Add Type:=msoControlButton, Before:=1
        .Controls(1).Caption = "Close Application"
        .Controls(1).OnAction = "Closeup"
        .Controls(1).FaceId = 263
        
        
        
        .Visible = True
        
    End With
End Sub
Sub Admin_Access()
    Dim pwd As String
    
    'better to use a textbox on a userform  with the PasswordChar property set to *
    pwd = InputBox("Password Please")
    
    If pwd = "Password" Then
    
        Call Hamstring_Off
        
    Else
    
        MsgBox "Sorry, that is the wrong password.", vbCritical, "Oops"
        
    End If
    
    SetForegroundWindow (Application.hwnd)
End Sub

Public Sub Closeup()
     
    On Error Resume Next
    
    Call Hamstring_Off
     
    Application.CommandBars("MAIN_BAR").Delete
    
    If ThisWorkbook.ReadOnly = False Then
    
        ThisWorkbook.Save
        
    End If
    Close_Flag = True
    Application.DisplayAlerts = False
        
    Application.Quit
    
End Sub
Sub Hamstring_On()
    
    Dim item As CommandBar
    
    Dim Ad_Item
    Dim Mb As VbMsgBoxResult
    
    If Application.CommandBars(1).Enabled = False Then
    
        Exit Sub
        
    End If
    
    Application.DisplayAlerts = False
      
    For Each item In Application.CommandBars
        
        If item.Name <> "MAIN_BAR" Then
        
            item.Enabled = False
            
        End If
        
    Next item
    
    SaveSetting App_Name, Sect2, "DisplayWorkbookTabs", CStr(ActiveWindow.DisplayWorkbookTabs)
    ActiveWindow.DisplayWorkbookTabs = False
    
    SaveSetting App_Name, Sect2, "DisplayFormulaBar", CStr(Application.DisplayFormulaBar)
    Application.DisplayFormulaBar = False
    
    SaveSetting App_Name, Sect2, "Task Pane", CStr(Application.CommandBars("Task Pane").Visible)
    Application.CommandBars("Task Pane").Visible = False
    
    SaveSetting App_Name, Sect2, "ShowWindowsInTaskbar", CStr(Application.ShowWindowsInTaskbar)
    Application.ShowWindowsInTaskbar = False
    
    SaveSetting App_Name, Sect2, "IgnoreRemoteRequests", CStr(Application.IgnoreRemoteRequests)
    Application.IgnoreRemoteRequests = True
    
    SaveSetting App_Name, Sect2, "AutoRecover", CStr(Application.AutoRecover.Enabled)
    Application.AutoRecover.Enabled = False
    
    On Error Resume Next
        Application.VBE.MainWindow.Visible = False
    On Error GoTo 0
    
    '+ = Shift, ^ = Ctrl, % = Alt
    
    Application.OnKey "{DELETE}", ""
    Application.OnKey "+{DELETE}", ""
    Application.OnKey "^{DELETE}", ""
    Application.OnKey "{BACKSPACE}", ""
    Application.OnKey "+{INSERT}", ""
    Application.OnKey "^c", ""
    Application.OnKey "^C", ""
    Application.OnKey "^x", ""
    Application.OnKey "^X", ""
    Application.OnKey "^v", ""
    Application.OnKey "^V", ""
    
    Application.OnKey "^Q", ""
    Application.OnKey "^q", ""
    Application.OnKey "^W", ""
    Application.OnKey "^w", ""
    Application.OnKey "^N", ""
    Application.OnKey "^n", ""
    Application.OnKey "^O", ""
    Application.OnKey "^o", ""
    Application.OnKey "^P", ""
    Application.OnKey "^p", ""
    Application.OnKey "^F", ""
    Application.OnKey "^f", ""
    Application.OnKey "^G", ""
    Application.OnKey "^g", ""
    Application.OnKey "^H", ""
    Application.OnKey "^h", ""
    Application.OnKey "^A", ""
    Application.OnKey "^a", ""
    Application.OnKey "^K", ""
    Application.OnKey "^k", ""
    Application.OnKey "^L", ""
    Application.OnKey "^l", ""
    Application.OnKey "^S", ""
    Application.OnKey "^s", ""
    
   
    
    Application.OnKey "^{PGUP}", ""
    Application.OnKey "^{PGDN}", ""
    Application.OnKey "^{TAB}", ""
    Application.OnKey "+^{TAB}", ""
    Application.OnKey "{F1}", ""
    Application.OnKey "^{F1}", ""
    Application.OnKey "%{F1}", ""
    Application.OnKey "+%{F1}", ""
    Application.OnKey "{F2}", ""
    Application.OnKey "{F3}", ""
    Application.OnKey "+{F3}", ""
    Application.OnKey "^{F3}", ""
    Application.OnKey "+^{F3}", ""
    Application.OnKey "{F4}", ""
    Application.OnKey "+{F4}", ""
    Application.OnKey "^{F4}", ""
    Application.OnKey "%{F4}", ""
    Application.OnKey "+^{F4}", ""
    Application.OnKey "{F5}", ""
    Application.OnKey "+{F5}", ""
    Application.OnKey "^{F5}", ""
    Application.OnKey "{F6}", ""
    Application.OnKey "^{F6}", ""
    Application.OnKey "+^{F6}", ""
    Application.OnKey "{F7}", ""
    Application.OnKey "%{F8}", ""
    Application.OnKey "^{F9}", ""
    Application.OnKey "^{F10}", ""
    Application.OnKey "{F11}", ""
    Application.OnKey "+{F11}", ""
    Application.OnKey "^{F11}", ""
    Application.OnKey "%{F11}", ""
    Application.OnKey "{F12}", ""
    Application.OnKey "+{F12}", ""
    Application.OnKey "^{F12}", ""
    
    Application.Caption = "Custom Application"
    ActiveWindow.Caption = "Untitled"
    
    Application.CommandBars.DisableAskAQuestionDropdown = True
    Application.CommandBars.DisableCustomize = True
    
'    bBuildCommandBars is contained in the Code Module provided in the
'    CD that comes with PED First Edition by Bullen Bovey and Green
'    It provides a table driven method to build a new command bar to replace the Excel Default
'    Call bBuildCommandBars
'    wksCommandBars is the worksheet that contains the Table that drives bBuildCommandBars
'    Application.CommandBars(wksCommandBars.Range("A2").Value).RowIndex = 1
'   Alternatively, build a new menu bar from scratch
    
    Application.DisplayAlerts = True
    
    Application.Calculation = xlCalculationManual
    
End Sub

Sub Hamstring_Off()
    
    Dim item As CommandBar
    
    On Error GoTo 0
    
    For Each item In Application.CommandBars
    
        item.Enabled = True
    
    Next item
    
    ActiveWindow.DisplayWorkbookTabs = CBool(GetSetting(App_Name, Sect2, "DisplayWorkbookTabs", True))
    Application.DisplayFormulaBar = CBool(GetSetting(App_Name, Sect2, "DisplayFormulaBar", True))
    Application.CommandBars("Task Pane").Visible = CBool(GetSetting(App_Name, Sect2, "Task Pane", False))
    Application.ShowWindowsInTaskbar = CBool(GetSetting(App_Name, Sect2, "ShowWindowsInTaskbar", True))
    Application.IgnoreRemoteRequests = CBool(GetSetting(App_Name, Sect2, "IgnoreRemoteRequests", False))
    Application.AutoRecover.Enabled = CBool(GetSetting(App_Name, Sect2, "AutoRecover", True))
    
    On Error Resume Next
    
    DeleteSetting App_Name, Sect2
    
    Application.OnKey "{DELETE}"
    Application.OnKey "+{DELETE}"
    Application.OnKey "^{DELETE}"
    Application.OnKey "{BACKSPACE}"
    Application.OnKey "+{INSERT}"
    Application.OnKey "^c"
    Application.OnKey "^C"
    Application.OnKey "^x"
    Application.OnKey "^X"
    Application.OnKey "^v"
    Application.OnKey "^V"
    
    Application.OnKey "^Q"
    Application.OnKey "^q"
    Application.OnKey "^W"
    Application.OnKey "^w"
    Application.OnKey "^N"
    Application.OnKey "^n"
    Application.OnKey "^O"
    Application.OnKey "^o"
    Application.OnKey "^P"
    Application.OnKey "^p"
    Application.OnKey "^F"
    Application.OnKey "^f"
    Application.OnKey "^G"
    Application.OnKey "^g"
    Application.OnKey "^H"
    Application.OnKey "^h"
    Application.OnKey "^A"
    Application.OnKey "^a"
    Application.OnKey "^K"
    Application.OnKey "^k"
    Application.OnKey "^L"
    Application.OnKey "^l"
    Application.OnKey "^S"
    Application.OnKey "^s"
    
    Application.OnKey "^{PGUP}"
    Application.OnKey "^{PGDN}"
    Application.OnKey "^{TAB}"
    Application.OnKey "+^{TAB}"
    Application.OnKey "{F1}"
    Application.OnKey "^{F1}"
    Application.OnKey "%{F1}"
    Application.OnKey "+%{F1}"
    Application.OnKey "{F2}"
    Application.OnKey "{F3}"
    Application.OnKey "+{F3}"
    Application.OnKey "^{F3}"
    Application.OnKey "+^{F3}"
    Application.OnKey "{F4}"
    Application.OnKey "+{F4}"
    Application.OnKey "^{F4}"
    Application.OnKey "%{F4}"
    Application.OnKey "+^{F4}"
    Application.OnKey "{F5}"
    Application.OnKey "+{F5}"
    Application.OnKey "^{F5}"
    Application.OnKey "{F6}"
    Application.OnKey "^{F6}"
    Application.OnKey "+^{F6}"
    Application.OnKey "{F7}"
    Application.OnKey "%{F8}"
    Application.OnKey "^{F9}"
    Application.OnKey "^{F10}"
    Application.OnKey "{F11}"
    Application.OnKey "+{F11}"
    Application.OnKey "^{F11}"
    Application.OnKey "%{F11}"
    Application.OnKey "{F12}"
    Application.OnKey "+{F12}"
    Application.OnKey "^{F12}"
    
    Application.Caption = ""
    ActiveWindow.Caption = False
    
    Application.CommandBars.DisableAskAQuestionDropdown = False
    Application.CommandBars.DisableCustomize = False
    
    Application.Calculation = xlCalculationAutomatic
    
End Sub
 
Upvote 0
And I suppose I should explain the open code. The idea is that if the user has other workbooks open you don't want to completely lock up the current instance of Excel, thereby effectively "hiding" their other workbooks, possibly causing them to lose their work. In the case that there are other workbooks open, then the cose will spawn a SECOND instance of the Excel Application, and opne the workbook in THAT one. the result is 2 separate Excel instances, one with the users other open workbooks, and one with ONLY the the workbook containing this code.

If I didn't mention it: this whole code subset is base don teh assumption that you, as teh developer, will use a non-readonly copy o fthe workbook for developement, and when you distribute a copy for use (probably on the network drive at work) it will be readonly. This is good practice to follow. If you have data that you want the user to be able to save, I recommend that you build code to save it in a separate file, so you can simply replace this file with a new readonly copy to update the code without affecting the user's data.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Disable 'X' on Worksheet
Replies
4
Views
136
Pacman52
P
G
  • Question Question
Disable Cut Copy Paste
Replies
1
Views
839
jkpieterse
jkpieterse
P
  • Question Question
Trying to Hide the Min Max Close at top right
Replies
0
Views
417
Polino
P
H
  • Solved
Disabling All VBA code from worksheet and/or workbook
Replies
2
Views
339
hazmat
H
P
  • Question Question
Selected Cell Shown in Different Cell
Replies
2
Views
273
Pacman52
P

Forum statistics

Threads
1,224,521
Messages
6,179,277
Members
452,902
Latest member
Knuddeluff

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top