Option Explicit
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwnewlong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const HWND_TOP As Long = 0
Public Event CellKeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer, ByVal Target As Range)
Public Event CellKeyPress(ByVal KeyAscii As MSForms.ReturnInteger, ByVal Target As Range)
Private phWnd As Long
Private pPointsPerPixelX As Single
Private pPointsPerPixelY As Single
Private pTarget As Range
Friend Property Set Target(Range As Range)
Set pTarget = Range
End Property
Friend Property Get Target() As Range
Set Target = pTarget
End Property
Private Sub RemoveCaption()
SetWindowLong phWnd, -16, GetWindowLong(phWnd, -16) And Not &HC00000
DrawMenuBar phWnd
End Sub
Private Sub MakeToolWin()
SetWindowLong phWnd, -20, GetWindowLong(phWnd, -20) And &H80
End Sub
Private Sub MakeAlmostTransparent()
SetWindowLong phWnd, -20, GetWindowLong(phWnd, -20) Or &H80000
SetLayeredWindowAttributes phWnd, 0, 1, &H2&
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
RaiseEvent CellKeyDown(KeyCode, Shift, pTarget)
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
RaiseEvent CellKeyPress(KeyAscii, pTarget)
End Sub
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Application.EnableEvents = False
Set pTarget = ActiveCell
pTarget.Select
Application.EnableEvents = True
End Sub
Private Sub UserForm_Initialize()
Dim hdc As Long
If Val(Application.Version) < 9 Then
phWnd = FindWindow("ThunderXFrame", Caption)
Else
phWnd = FindWindow("ThunderDFrame", Caption)
End If
Call RemoveCaption
Call MakeToolWin
hdc = GetDC(0)
pPointsPerPixelX = 72 / GetDeviceCaps(hdc, LOGPIXELSX)
pPointsPerPixelY = 72 / GetDeviceCaps(hdc, LOGPIXELSY)
Me.BackColor = vbWhite
TextBox1.BackColor = vbWhite
TextBox1.BorderStyle = fmBorderStyleNone
TextBox1.SpecialEffect = fmSpecialEffectFlat
ReleaseDC 0, hdc
RemoveCaption
MakeToolWin
MakeAlmostTransparent
End Sub
Friend Sub SetPosition(x1 As Single, y1 As Single, x2 As Single, y2 As Single)
Dim X As Long, Y As Long, xx As Long, yy As Long
TextBox1.Font.Size = pTarget.Font.Size
X = CLng(ActiveWindow.PointsToScreenPixelsX(0) + (x1 / pPointsPerPixelX))
Y = CLng(ActiveWindow.PointsToScreenPixelsY(0) + (y1 / pPointsPerPixelY))
xx = CLng((x2 / pPointsPerPixelX))
yy = CLng((y2 / pPointsPerPixelY))
SetWindowPos phWnd, HWND_TOP, X, Y, xx, yy, 0
Application.EnableEvents = False
TextBox1.Select False
Application.EnableEvents = True
End Sub
Private Sub UserForm_Resize()
TextBox1.Move 0, 0, Me.width, Me.height
End Sub