Option VBASupport 1
Option Explicit
''/////////////////////////////////////////////////////////////////
''// 3rd August 2010 //
''// Created by Vog
''/////////////////////////////////////////////////////////////////
#If VBA7 Then
Public Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) _
As LongPtr
Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
lParam As Any) _
As LongPtr
Public Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr) _
As LongPtr
Public Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr) _
As Long
Public Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
#Else
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) _
As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
Public Declare Function SetTimer Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) _
As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) _
As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
#End If
Private Const EM_SETPASSWORDCHAR = &HCC
#If VBA7 Then
Private Const nIDE As LongPtr = &H100
Private hdlEditBox As LongPtr
Private Fgrndhdl As LongPtr
#Else
Private Const nIDE As Long = &H100
Private hdlEditBox As Long
Private Fgrndhdl As Long
#End If
#If VBA7 Then
Public Function TimerFunc( _
ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal nEvent As LongPtr, _
ByVal nSecs As Long) As Long
Dim hdlwndAct As LongPtr
#Else
Public Function TimerFunc( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal nEvent As Long, _
ByVal nSecs As Long) As Long
Dim hdlwndAct As Long
#End If
'// Do we have a handle to the EditBox
If hdlEditBox > 0 Then Exit Function
'// Get the handle to the ActiveWindow
hdlwndAct = GetActiveWindow()
'// Get the Editbox handle
hdlEditBox = FindWindowEx(hdlwndAct, 0, "Edit", "")
'// Set the password character for the InputBox
SendMessage hdlEditBox, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0
End Function
Public Function InPutBoxPwd(fPrompt As String, _
Optional fTitle As String, _
Optional fDefault As String, _
Optional fXpos As Long, _
Optional fYpos As Long, _
Optional fHelpfile As String, _
Optional fContext As Long) As String
Dim sInput As String
'// Initialize
hdlEditBox = 0
Fgrndhdl = GetForegroundWindow
'// Windows-Timer
SetTimer Fgrndhdl, nIDE, 100, AddressOf TimerFunc
'// Main InputBox
If fXpos Then
sInput = InputBox(fPrompt, fTitle, fDefault, fXpos, fYpos, fHelpfile, fContext)
Else
sInput = InputBox(fPrompt, fTitle, fDefault, , , fHelpfile, fContext)
End If
'//
KillTimer Fgrndhdl, nIDE
'// Pass result
InPutBoxPwd = sInput
End Function
Sub Clearrange(sRange As String, sWorksheet As String)
Worksheets(sWorksheet).Range(sRange).ClearContents
End Sub
Sub ClearHouse1(sWorksheet As String)
' if the layout of the sheet changes,
' add or edit the ranges here for the new layout
Clearrange ("A6:A1077"), sWorksheet 'Date
Clearrange ("B6:B1077"), sWorksheet 'Quantity
Clearrange ("C6:C1077"), sWorksheet 'Name
Clearrange ("D6:D1077"), sWorksheet 'Code
Clearrange ("F6:F1077"), sWorksheet 'Serial Number
Clearrange ("I6:I1077"), sWorksheet 'Delivery Cost
Clearrange ("L6:L1077"), sWorksheet 'Invoice Number
Clearrange ("O6:Q1077"), sWorksheet 'Ebay Selling Price, Postage Customer Paids & Postage I Paid
End Sub
Sub ClearHouserent1()
Const ok As String = "jib"
Dim pw As String
pw = InPutBoxPwd("Are you sure you want to clear this sheet") '<<<<<<<<<<<<<<<<<<<<<< Changed line
If pw <> ok Then
MsgBox "Wrong password"
Exit Sub
End If
Call ClearHouse1("Calculator")
End Sub
