| |
▼ＯＮ さん：
>上記で
>マクロブック2画面で表示される
>マウス移動で、2画面の切替が出来ない
>↑
>マウス移動で、アクティブウインドウの切替が出来ないものかと思っています
マウスカーソルの移動でウィンドウの切替えを行うということですか。
違和感のあるUIのような気がします。
通常、ウィンドウ整列した状態ではマウスカーソルに合わせてウィンドウが切替わらないので...
それはさておき、うまくいかない点についてですが...
なんかロジックが雑多で確実性に欠けてるように思います。
簡潔にちょっと直してみました。
'ブックモジュール(ThisWorkbook)
Option Explicit
Private Sub Workbook_Activate()
Dim wn As Window, aw As Window
Set aw = ActiveWindow
If ActiveWorkbook.Windows.Count > 1 Then
For Each wn In ActiveWorkbook.Windows
wn.Activate
Next
aw.Activate
mouse_monitore_Start
End If
End Sub
Private Sub Workbook_Deactivate()
ActiveWindow.WindowState = xlMaximized
mouse_monitore_Stop
End Sub
'Sheet1モジュール
Option Explicit
Private Sub ToggleButton1_Click()
Dim ww!
'If ToggleButton1.Value = True Then
If ActiveWorkbook.Windows.Count = 1 Then
ToggleButton1.Caption = "戻 る"
Parent.Unprotect
ActiveWindow.NewWindow
With Windows(Parent.Name & ":1")
.Activate
ActiveWorkbook.Windows.Arrange ArrangeStyle:=xlVertical
ww = .Width + 2 - 240
.Width = 240
End With
With Windows(Parent.Name & ":2")
.Activate
.Left = .Left - ww: .Width = .Width + ww
End With
Sheets("Sheet2").Select
Parent.Protect Structure:=False, Windows:=True
mouse_monitore_Start
Else
ToggleButton1.Caption = "ＤＴセット(2画面表示)"
Parent.Unprotect
Windows(Parent.Name & ":2").Close
ActiveWindow.WindowState = xlMaximized
mouse_monitore_Stop
End If
End Sub
'標準モジュール
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function SetTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long _
, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Sub KillTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long)
Private Declare Sub GetCursorPos Lib "user32" ( _
lpPoint As POINTAPI)
Private Declare Function WindowFromPoint Lib "user32" ( _
ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Sub GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long)
Private TimerId As Long
Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long _
, ByVal idEvent As Long, ByVal dwTime As Long)
On Error Resume Next
If Not ThisWorkbook Is ActiveWorkbook Then KillTimer 0, idEvent
Dim Point As POINTAPI, Caption$
GetCursorPos Point
hWnd = WindowFromPoint(Point.x, Point.y)
If hWnd = 0 Then Exit Sub
Caption = String(256, vbNullChar)
GetWindowText hWnd, Caption, Len(Caption)
Caption = Left$(Caption, InStr(Caption, vbNullChar) - 1)
If Caption = "" Then Exit Sub
If Mid(Caption, Len(Caption) - 1, 1) <> ":" Then Exit Sub
If ActiveWindow.Caption <> Caption Then Windows(Caption).Activate
End Sub
Sub mouse_monitore_Start()
If TimerId Then mouse_monitore_Stop
TimerId = SetTimer(0&, 0&, 0&, AddressOf TimerProc)
End Sub
Sub mouse_monitore_Stop()
If TimerId Then KillTimer 0&, TimerId
TimerId = 0
End Sub
|
|
yoshi
- 09/6/6(土) 16:54 -
