Мои экраны полны вещей, все еще нужно добавить небольшую электронную таблицу, может быть, один дюйм в высоту и шириной менее одного дюйма. Есть ли решение для этого? Я не делаю сложные вычисления, просто немного математики, но мне нужно, чтобы это окно всегда было сверху.
2 ответа
1
Это выстрел в темноте, я запускаю Win 7 64bit, но попробуйте это:
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 uFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Const HWND_TOPMOST = -1 Const HWND_NOTOPMOST = -2
Sub AlwaysOnTop()
Dim hwnd As Long Dim res As Long
hwnd = FindWindow("XLMAIN", vbNullString) res = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, vbNull)
End Sub
Sub NotAlwaysOnTop()
Dim hwnd As Long Dim res As Long
hwnd = FindWindow("XLMAIN", vbNullString) res = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, vbNull)
End Sub
Поместите это в VBA и затем запустите макрос Alwaysontop. Посмотрим, останется ли он на вершине. Это не работает для меня, даже когда я преобразовал его в 64-разрядную версию.
1
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 ShowWindow Lib "user32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
Public Function ResizeAccess()
Dim lngReturn As Long
Dim hWnd As Long
' get app's window handle
hWnd = Application.hWndAccessApp
' move to upper left vorner of screen 0, 0
' resize app window to 800 x 600
lngReturn = SetWindowPos(hWnd, 0, 0, 0, 800, 600, 0)
' normalize window
lngReturn = ShowWindow(hWnd, 1)
End Function