半角チルダ

ExcelVBA、その他。
覚え書きや、補足資料などのスクラップブック。
end-u(1037781)

■Worksheet_Scrollイベント(もどき:D

2010-09-14 23:00:00 | VBA Tips
excelfactory.netネタです。

画面に表示されたセル範囲が変化した時のイベントを捉えたいというニーズがあったとします。
例えば
・スクロールバー操作やマウスホイール操作で画面をスクロール
・ズーム変更
・行列の高さや幅を変更
・行、列の表示/非表示
こういった操作をトリガーにして何らかのマクロを実行したい、とか。

Excel自体にはWorksheet_Scrollイベントはありませんから、
Loopを使った常時監視や、タイムラグに妥協しつつWorksheet_SelectionChangeイベントを使うか、WindowsAPIを駆使して実現するしかないような...と思ってました。
http://excelfactory.net/excelboard/excelvba/cfs.cgi?word=106710&logs=14.txt
この当時に思いついてれば良かったんですけど。

比較的簡単な手法として、Frame.ControlをWorksheetに配置して、そのLayoutイベントを利用する手がありました。
まず
Sub Macro1()
  Sheets.Add.OLEObjects.Add ClassType:="Forms.Frame.1", Left:=0, Top:=0, Width:=1, Height:=1
End Sub

..で追加されたSheetModuleに以下のコードを置きます。
'SheetModule
Option Explicit

Private Type CHKVALUE '各値保持用
  adrs As String  'VisibleRangeアドレス
  x  As Single  'Width
  y  As Single  'Height
  z  As Long   'Zoom
End Type

Private chk As CHKVALUE
'-------------------------------------------------
Private Sub Frame1_Layout()
  Dim msg(4) As String 'StatusBar表示用文字列
  Dim x   As Single 'Width変化量
  Dim y   As Single 'Height変化量
  Dim z   As Long  'Zoom変化量

  If Not (ActiveSheet Is Me) Then Exit Sub

  x = Me.Frame1.Left - chk.x
  y = Me.Frame1.Top - chk.y
  With ActiveWindow
    z = .Zoom - chk.z
    With .Panes(.Panes.Count).VisibleRange
      With .Item(.Count)
        '変化なければ抜ける(重複処理対策)
        If (x = 0) And (y = 0) And (z = 0) Then
          If .Left = chk.x Then
            If .Top = chk.y Then Exit Sub
          End If
        End If
        chk.x = .Left
        chk.y = .Top
      End With
      chk.adrs = .Address(0, 0)
    End With
    chk.z = .Zoom
  End With

  '変化項目と変化量の記録
  msg(0) = "Change: Scroll"
  If x <> 0 Then msg(0) = "Chenge: Width"
  If y <> 0 Then msg(0) = "Chenge: Height"
  If z <> 0 Then msg(0) = "Change: Zoom"
  msg(1) = "VisibleRange: " & chk.adrs
  msg(2) = "Width: " & x
  msg(3) = "Height: " & y
  msg(4) = "Zoom: " & z
  Application.StatusBar = Join(msg, "|")
  '再配置
  Me.Frame1.Left = chk.x
  Me.Frame1.Top = chk.y
End Sub

対象シートがActiveの時だけ実行されるように、ThisWorkbookModuleには以下のコード。
'ThisWorkbookModule
Option Explicit

Private Const WKSHT = "Sheet1"  '対象Sheet名
'-------------------------------------------------
Private Sub Workbook_Activate()
  With Sheets(WKSHT).Frame1
    .Visible = False
    .Visible = True
  End With
End Sub
'-------------------------------------------------
Private Sub Workbook_Deactivate()
  Sheets(WKSHT).Frame1.Visible = False
  Application.StatusBar = False
End Sub
'-------------------------------------------------
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  If Sh.Name = WKSHT Then Workbook_Activate
End Sub
'-------------------------------------------------
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
  If Sh.Name = WKSHT Then Workbook_Deactivate
End Sub

取り敢えずStatusBarに変化内容を表示するようにしています。





列のWidthと行Height、画面のZoomについては変化量を表示。
VisibleRangeについては変化した後のアドレスを表示するサンプルです。

ある程度はウマくいくようですが、完璧ではありません。
Excel.Application自体のWindowsリサイズには対応できません。
また、2007から導入されたStatusBarのズームスライダーからZoom変更するとエラーになります。(2010ではエラーは発生しないみたい)
..ので実用的とは言えないかも :P



#2010.11.16 追記)
ぃや、やっぱりダメでした。Frame.ControlのLayoutイベントの制御ってなかなか難しいですね。
VisibleRange最終セルに再配置しなければいけないのが厄介です。
ズームスライダーだけじゃなくて[Ctrl]キー+マウスホイールによるZoom変更でエラー発生するのが質悪い。
DoEventsで誤魔化せば2010では使えそうなんだけど...

...って事で本記事はボツ扱いでお願いします..orz

Comment    この記事についてブログを書く
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする
« ■xl2007:条件付き書式の色設... | TOP | ■VBA QueryTable.Parameters »
最新の画像もっと見る

post a comment

ブログ作成者から承認されるまでコメントは反映されません。

Recent Entries | VBA Tips