| |
遅くなりました 申し訳ありません m(_ _)m
皆様 ありがとうございます
横道にそれますが
周知の事項かも知れませんが・・・下記に気がつきました、
シートにコマンドボタンをはって
新しいウインドウを開いて、並べて表示の状態で
：1、：2どちらでもいいので、コマンドボタンを押すと
アクティブでないシートのコマンドボタンに斜線がかかって
そのボタンは反応しなくなります
斜線がない方のボタンは操作可能です
操作したウィンドウ側をいったん閉じない限りそのウインドウの操作権は
そのまま保持しているようです
>ブックの×ボタンで閉じられないようにしたいと思っていますが
>上記に相当するイベントは無いようです
と、関連があるような気がしますが・・・・
この
>操作したウィンドウ側をいったん閉じない限りそのウインドウ操作権は
>そのまま保持しているようです
は、コード上で初期化？することは出来ますか
あわせて、この状況をググって見たのですが引っ掛けることは出来ませんでした
参考URL等あれば、ご紹介よろしくお願いいたします
本題のほうですが
もやもやと、霧の彼方で、ウインドウのくくりで操作できないものかと思っていたのですが
nさん、yoshiさんから、さくっとその回答が・・・
ありがとうございました 勉強になります
どちらも動作はわかるのですが、自分ではかけないコードです
あわせて、具体的にどこが難しいのかわからないのですが
理解が難しいです
>↑の仕様で、ブックの保護(ウィンドウをチェック)を用いると以下のように簡単でしょう。
ブックの保護(ウィンドウをチェック)だけの違いでないような気もしますが
今回は、yoshiさん のコードを参考にさせて頂きたいと思います
nさん、申し訳ありません
また
neptuneさんのAPIについては、別途、機会を設けてもう少し勉強したいと思います
申し訳ありませんがよろしくお願いいたします
yoshiさん
>↑の仕様で、
は、
ActiveWindow.Width = ActiveWindow.Width + 2
でなく
.Width = max_w - 142
のように、変数の値でセットしたいのですが
[VBA] Public 宣言された変数の有効期間
ht tp://support.microsoft.com/default.aspx?scid=kb;ja;408871
のためか
Public 変数の値が破棄されてしまうようなので
Workbook_Activate
ToggleButton1_Click
で、各々取得しています
他の変更として
・Workbook_Open時でなく、トグルボタンを設けて、新しいウインドウを開くことにしました
・他に、後2画面表示時、マウスが乗ったウインドウをアクティブにしました
これは別途、以前webでメモしたものを使用しました（記載先見つかりませんでした）
極力、nさん の コードに 近づけたいと思っていましたが
動かすために
Workbook_Open時、Application.EnableEvents = False とか
ToggleButton1_Click時に、Application.EnableEvents = True とか
Workbook_Activate時等、変な記述となっています
現状、解決できない問題は
・別ブックを開いて操作すると、2画面表示がうまく機能できなくなってしまいます
・この状態で、ブックを切り替えると、新しいウインドウが作られてしまいます
他にもありそうですが・・・・
これは
>あわせて、具体的にどこが難しいのかわからないのですが
~~~~~~~~~~~~~~~~~~~~~~
>理解が難しいです
によるものと思います
解決のためのヒント、アドバイス等あればよろしくお願いいたします
新規ブックの Sheet1 の ｂ2あたりにトグルボタンを作成して
下記コード貼れば再現できると思います
よろしくお願いいたします
----------------------------------------------------------------------
'Sheet1モジュール
Option Explicit
Public max_h As Double
Public max_w As Double
Private Sub ToggleButton1_Click()
'Stop
Application.EnableEvents = True
Dim i As Integer
Dim ck As Integer
ck = 0
If Sheet1.ToggleButton1.Value = False Then
ToggleButton1.Caption = "ＤＴセット(2画面表示)"
del_w
StopSample
Else
For i = 1 To Windows.Count
If ActiveWindow.Caption = ActiveWorkbook.Name & ":1" Then
ck = 1
End If
Next
If ck > 0 Then
Exit Sub
End If
ToggleButton1.Caption = "戻 る"
Unprotect
On Error Resume Next
ActiveWindow.NewWindow
ActiveWindow.WindowState = xlMaximized
max_h = ActiveWindow.Height - 20.25 'なぜか-20.25 必要
max_w = ActiveWindow.Width
Windows(ActiveWorkbook.Name & ":1").Activate
With ActiveWindow
.WindowState = xlNormal '←元に戻す と 同等
.Top = 0
.Left = 0
.Height = max_h
.Width = 240
End With
'Windows(Name & ":2").Activate
Windows(ActiveWorkbook.Name & ":2").Activate
With ActiveWindow
.WindowState = xlNormal
.Top = 0
.Left = 240
.Height = max_h
.Width = max_w - 240
End With
ActiveWorkbook.Protect Structure:=False, Windows:=True
Worksheets(2).Select
On Error GoTo 0
StartSample
End If
End Sub
Public Sub del_w()
Windows(ActiveWorkbook.Name & ":2").Activate
ActiveWorkbook.Unprotect
ActiveWindow.Close
Windows(ActiveWorkbook.Name).WindowState = xlMaximized
End Sub
----------------------------------------------------------------------
'ThisWorkbookモジュール
Option Explicit
'Public max_h As Double '標準モジュールでないと保存されない？？？
'Public max_w As Double
Public max_h As Double
Public max_w As Double
Private Sub Workbook_Activate()
Dim i As Integer
Dim ck As Integer
ck = 0
For i = 1 To Windows.Count
If ActiveWindow.Caption = ActiveWorkbook.Name & ":1" Then
ck = 1
End If
Next
If ck > 0 Then
Exit Sub
End If
Sheets(1).ToggleButton1.Caption = "戻 る"
ActiveWindow.NewWindow
Unprotect
On Error Resume Next
Windows(ActiveWorkbook.Name & ":1").Activate
With ActiveWindow
.WindowState = xlNormal '←元に戻す と 同等
.Top = 0
.Left = 0
.Height = max_h
.Width = 240
End With
Windows(ActiveWorkbook.Name & ":2").Activate
With ActiveWindow
.WindowState = xlNormal
.Top = 0
.Left = 240
.Height = max_h
End With
ActiveWorkbook.Protect Structure:=False, Windows:=True
Worksheets(2).Select
On Error GoTo 0
End Sub
Private Sub Workbook_Deactivate()
Unprotect
ActiveWindow.WindowState = xlMaximized
End Sub
Private Sub Workbook_Open()
Application.EnableEvents = False
End Sub
----------------------------------------------------------------------
'Module1モジュール
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 Function GetParent Lib "user32" ( _
ByVal Hwnd As Long) As Long
Private Const ERROR_SUCCESS As Long = 0
Private myTimerId As Long
Sub TimerProc(ByVal Hwnd As Long, ByVal uMsg As Long _
, ByVal idEvent As Long, ByVal dwTime As Long)
Static myX As Long, myY As Long
Dim myPoint As POINTAPI
Dim myHwnd As Long
GetCursorPos myPoint
With myPoint
If .x = myX And .y = myY Then Exit Sub
myX = .x: myY = .y
End With
myHwnd = WindowFromPoint(myX, myY)
myHwnd = GetParent(myHwnd)
If myHwnd = ERROR_SUCCESS Then Exit Sub
myHwnd = GetParent(myHwnd)
If myHwnd <> Application.Hwnd Then Exit Sub
Debug.Print myX, myY
If ActiveWindow.WindowState <> xlMaximized Then
If myX < 350 Then
On Error Resume Next
Windows(ActiveWorkbook.Name & ":1").Activate
On Error GoTo 0
Else
On Error Resume Next
Windows(ActiveWorkbook.Name & ":2").Activate
On Error GoTo 0
End If
End If
End Sub
Sub StartSample()
myTimerId = SetTimer(0&, 0&, 0&, AddressOf TimerProc)
End Sub
Sub StopSample()
KillTimer 0&, myTimerId
End Sub
|
|
ON
- 09/5/27(水) 18:44 -
