Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Dim hWndForm As Long
Private Declare Function SetParent Lib "user32" ( _
ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Private 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
Private Declare Function GetAncestor Lib "user32.dll" ( _
ByVal hwnd As Long, ByVal gaFlags As Long) As Long
Private Sub cbTags_Change()
Dim tags As String
Dim tagsColumn As Range
cbTags.HideSelection = True
Set tagsColumn = Range("TagsColumn")
tag = cbTags
ActiveSheet.Range("TableData").AutoFilter Field:=tagsColumn.Column, Criteria1:="*" & tag & "*"
End Sub
Private Sub CommandButton1_Click()
cbTags.SetFocus
MsgBox "This functionality is disabled during testing"
End Sub
Private Sub CommandButton2_Click()
cbTags.SetFocus
frmSearchTags.cbTags = ""
ActiveSheet.AutoFilterMode = False
End Sub
Private Sub UserForm_Initialize()
Dim Style As Long, Menu As Long
Dim pointcoordinates As pointcoordinatestype, horizontaloffsetinpoints As Double, verticaloffsetinpoints As Double
Dim AppXPoint, AppYPoint As Long
Const C_VBA6_USERFORM_CLASSNAME = "ThunderDFrame"
Dim AppHWnd As Long
Dim DeskHWnd As Long
Dim WindowHWnd As Long
Dim MeHWnd As Long
Dim Res As Long
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
Style = GetWindowLong(hWndForm, &HFFF0)
Style = Style And Not &HC00000
SetWindowLong hWndForm, &HFFF0, Style
DrawMenuBar hWndForm
AppHWnd = FindWindow("XLMAIN", Application.Caption)
If AppHWnd > 0 Then
DeskHWnd = FindWindowEx(AppHWnd, 0&, "XLDESK", vbNullString)
If DeskHWnd > 0 Then
WindowHWnd = FindWindowEx(DeskHWnd, 0&, "EXCEL7", ActiveWindow.Caption)
If WindowHWnd > 0 Then
Else
MsgBox "Unable to get the window handle of the ActiveWindow."
End If
Else
MsgBox "Unable to get the window handle of the Excel Desktop."
End If
Else
MsgBox "Unable to get the window handle of the Excel Application."
End If
MeHWnd = FindWindow(C_VBA6_USERFORM_CLASSNAME, Me.Caption)
If (MeHWnd > 0) And (WindowHWnd > 0) Then
Res = SetParent(MeHWnd, WindowHWnd)
If Res = 0 Then
MsgBox "The call to SetParent failed."
End If
End If
With Me
ActiveSheet.Range("A1").Select
horizontaloffsetinpoints = (.Width - .InsideWidth) / 2
verticaloffsetinpoints = 1
Call GetPointCoordinates(ActiveCell, pointcoordinates)
.StartUpPosition = 0
.Top = pointcoordinates.Top - verticaloffsetinpoints
.Left = pointcoordinates.Left - horizontaloffsetinpoints
End With
Debug.Print "Post Yin Gognyto:"
Debug.Print "-- left set to " & (pointcoordinates.Left - horizontaloffsetinpoints) & " --> result = " & Me.Left & ". Difference = " & (Me.Left - (pointcoordinates.Left - horizontaloffsetinpoints))
Debug.Print "-- top set to " & (pointcoordinates.Top - verticaloffsetinpoints) & " --> result = " & Me.Top & ". Difference = " & (Me.Top - (pointcoordinates.Top - verticaloffsetinpoints))
AppXPoint = Application.Left + 10
AppYPoint = Application.Top + 126
With Me
.StartUpPosition = 0
.Left = AppXPoint
.Top = AppYPoint
End With
Debug.Print "Post GrouchySmurf:"
Debug.Print "-- left set to " & AppXPoint & " --> result = " & Me.Left & ". Difference = " & (Me.Left - (AppXPoint))
Debug.Print "-- top set to " & AppYPoint & " --> result = " & Me.Top & ". Difference = " & (Me.Top - (AppYPoint))
Me.Show
End Sub
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = xlPrimaryButton Then
Call ReleaseCapture
Call SendMessage(hWndForm, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&)
End If
End Sub