Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


20463 / 76735 ←次へ | 前へ→

【61690】Re:新しいウインドを開くのウインドウを閉じるときイベント
お礼  ON  - 09/5/27(水) 18:44 -

引用なし
パスワード
   遅くなりました 申し訳ありません 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 の b2あたりにトグルボタンを作成して
下記コード貼れば再現できると思います
よろしくお願いいたします

----------------------------------------------------------------------
'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 = "DTセット(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
0 hits

【61498】新しいウインドを開くのウインドウを閉じるときイベント ON 09/5/13(水) 17:57 質問
【61504】Re:新しいウインドを開くのウインドウを閉... n 09/5/13(水) 22:40 発言
【61507】Re:新しいウインドを開くのウインドウを閉... yoshi 09/5/14(木) 2:26 お礼
【61515】Re:新しいウインドを開くのウインドウを閉... neptune 09/5/14(木) 10:19 発言
【61604】Re:新しいウインドを開くのウインドウを閉... ON 09/5/21(木) 16:18 お礼
【61615】Re:新しいウインドを開くのウインドウを閉... neptune 09/5/21(木) 22:31 回答
【61619】Re:新しいウインドを開くのウインドウを閉... n 09/5/22(金) 1:37 発言
【61624】Re:新しいウインドを開くのウインドウを閉... yoshi 09/5/22(金) 11:59 回答
【61690】Re:新しいウインドを開くのウインドウを閉... ON 09/5/27(水) 18:44 お礼
【61723】Re:新しいウインドを開くのウインドウを閉... ON 09/5/29(金) 21:15 お礼
【61737】Re:新しいウインドを開くのウインドウを閉... yoshi 09/5/30(土) 16:19 回答
【61804】Re:新しいウインドを開くのウインドウを閉... ON 09/6/5(金) 16:17 質問
【61808】Re:新しいウインドを開くのウインドウを閉... yoshi 09/6/5(金) 18:17 回答
【61809】Re:新しいウインドを開くのウインドウを閉... ON 09/6/5(金) 19:10 質問
【61817】Re:新しいウインドを開くのウインドウを閉... yoshi 09/6/6(土) 16:54 回答
【61930】Re:新しいウインドを開くのウインドウを閉... ON 09/6/12(金) 16:36 お礼
【61931】Re:新しいウインドを開くのウインドウを閉... ON 09/6/12(金) 16:37 発言
【61932】Re:新しいウインドを開くのウインドウを閉... ON 09/6/12(金) 16:39 発言

20463 / 76735 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free