Private Const MF_BYPOSITION As Long = &H400 ' Deletes the menus by position (this is our default).
Private Const MF_BYCOMMAND As Long = &H0 ' Deletes the menu by Command ID. This is rarely used and is shown here for information purposes only.
Private Const mlNUM_SYS_MENU_ITEMS As Long = 9 ' This is the number of items on the system menu
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, _
ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
#If Win64 Then
Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#Else
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#End If
Sub SetNumLockOn()
If Not CBool(GetKeyState(VK_NUMLOCK)) Then
keybd_event VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_NUMLOCK, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
End If
End Sub
Sub landeninstellingen()
Dim sDecimal As String
Dim sTHousand As String
Dim bUseSystem As Boolean
sDecimal = Application.DecimalSeparator
sTHousand = Application.ThousandsSeparator
bUseSystem = Application.UseSystemSeparators
End Sub
Sub landeninstellingenterugzetten()
Dim sDecimal As String
Dim sTHousand As String
Dim bUseSystem As Boolean
Application.DecimalSeparator = sDecimal
Application.ThousandsSeparator = sTHousand
Application.UseSystemSeparators = bUseSystem
End Sub
Public Sub EnableActiveDialogMenuControls(DialogCaption As String)
Dim lHandle As Long
'On Error Resume Next
DialogCaption = DialogCaption & vbNullChar
lHandle = FindWindowA(vbNullString, DialogCaption)
GetSystemMenu lHandle, True
End Sub
Public Sub DisableActiveDialogMenuControls(DialogCaption As String)
Dim lHandle As Long, lCount As Long
DialogCaption = DialogCaption & vbNullChar
lHandle = FindWindowA(vbNullString, DialogCaption)
' Only continue if the passed window handle isn't zero.
If lHandle <> 0 Then
' There are 9 items on the application control menu.
' Loop through and disable each one.
For lCount = 1 To mlNUM_SYS_MENU_ITEMS
' The nPosition of the DeleteMenu function will always be 0,
' because as we delete each menu item, the next one moves up
' into the first position (index of 0).
DeleteMenu GetSystemMenu(lHandle, False), 0, MF_BYPOSITION
Next lCount
End If
End Sub
Sub ExcelSluitenUitschakelen()
DisableActiveDialogMenuControls (Application.Caption)
End Sub
Sub ExcelSluitenAanzetten()
EnableActiveDialogMenuControls (Application.Caption)
End Sub
Public Sub RenameMSFormsFiles()
Const tempFileName As String = "MSForms - Copy.exd"
Const msFormsFileName As String = "MSForms.exd"
On Error Resume Next
'Try to rename the C:\Users\[user.name]\AppData\Local\Temp\Excel8.0\MSForms.exd file
RenameFile Environ("TEMP") & "\Excel8.0\" & msFormsFileName, Environ("TEMP") & "\Excel8.0\" & tempFileName
'Try to rename the C:\Users\[user.name]\AppData\Local\Temp\VBE\MSForms.exd file
RenameFile Environ("TEMP") & "\VBE\" & msFormsFileName, Environ("TEMP") & "\VBE\" & tempFileName
End Sub
Private Sub RenameFile(fromFilePath As String, toFilePath As String)
If CheckFileExist(fromFilePath) Then
DeleteFile toFilePath
Name fromFilePath As toFilePath
End If
End Sub
Private Function CheckFileExist(path As String) As Boolean
CheckFileExist = (Dir(path) <> "")
End Function
Private Sub DeleteFile(path As String)
If CheckFileExist(path) Then
SetAttr path, vbNormal
Kill path
End If
End Sub
