Excel2010.vba忘備録 シート移動をユーザーフォームで行いたい。
前提条件は次のとおり
Excel2010用,シートは上下に２ウィンドウ整列済み。
Excel2010はmdiだが2013からsdiで開くようだ。
別のＰＣのExcel2019はsdiで開くので実に面倒くさい。
別のＰＣのExcel2019はsdiで開くので実に面倒くさい。
ことの発端はonTimeなどでループ処理している際に他のシート名をクリックすると
たまに名前変更モードになってしまいループがストップしてしまって困った。
そこでユーザーフォームから上下２ウィンドウの下段側のみシートをボタンで選択したい。
そのための処理でハマってしまいちゃんと動作するまで半日費やしてしまった。
キモはWindowNumber=1とWindows(1)とは異なる、ということ。
やりたい事はボタンをクリックすればシートが移動する、ということだけ。
ただしアクティブシートが移動しないようにするには意外にハードルが高かった。
'+---------------------------------
'Sheet1
'+---------------------------------
Private Sub CommandButton1_Click()
Dim ws As Window, wsName As Variant, ii As Integer
Application.ScreenUpdating = False '+--- 画面を更新させない -----------+
ReDim wsName(2)
For ii = 1 To Windows.Count
If Windows(ii).WindowNumber = 1 Then 'ウィンドウナンバー1
wsName(1) = Windows(ii).Caption 'ウィンドウキャプションを取得する
End If
If Windows(ii).WindowNumber = 2 Then 'ok ウィンドウナンバー2
wsName(2) = Windows(ii).Caption 'ウィンドウキャプションを取得する
End If
Next ii
Windows(wsName(2)).Activate 'Window2をアクティブにする
Worksheets("Sheet1").Activate '●"Sheet1"をアクティブにする
Windows(wsName(1)).Activate 'Window1に戻す
Application.ScreenUpdating = True '+--- 画面を更新させる -------------+
End Sub
'+---------------------------------
'Sheet2
'+---------------------------------
Private Sub CommandButton2_Click()
Dim ws As Window, wsName As Variant, ii As Integer
Application.ScreenUpdating = False
ReDim wsName(2)
For ii = 1 To Windows.Count
If Windows(ii).WindowNumber = 1 Then
wsName(1) = Windows(ii).Caption
End If
If Windows(ii).WindowNumber = 2 Then
wsName(2) = Windows(ii).Caption
End If
Next ii
Windows(wsName(2)).Activate
Worksheets("Sheet2").Activate '●
Windows(wsName(1)).Activate
Application.ScreenUpdating = True
End Sub
'+---------------------------------
'Sheet3
'+---------------------------------
Private Sub CommandButton3_Click()
Dim ws As Window, wsName As Variant, ii As Integer
Application.ScreenUpdating = False
ReDim wsName(2)
For ii = 1 To Windows.Count
If Windows(ii).WindowNumber = 1 Then
wsName(1) = Windows(ii).Caption
End If
If Windows(ii).WindowNumber = 2 Then
wsName(2) = Windows(ii).Caption
End If
Next ii
Windows(wsName(2)).Activate
Worksheets("Sheet3").Activate '●
Windows(wsName(1)).Activate
Application.ScreenUpdating = True
End Sub
'+---------------------------------
'Sheet8
'+---------------------------------
Private Sub CommandButton4_Click()
Dim ws As Window, wsName As Variant, ii As Integer
Application.ScreenUpdating = False
ReDim wsName(2)
For ii = 1 To Windows.Count
'Debug.Print ActiveWorkbook.Windows(ii).WindowNumber
If Windows(ii).WindowNumber = 1 Then
wsName(1) = Windows(ii).Caption
End If
If Windows(ii).WindowNumber = 2 Then
wsName(2) = Windows(ii).Caption
End If
Next ii
Windows(wsName(2)).Activate
Worksheets("Sheet8").Activate '●
Windows(wsName(1)).Activate
Application.ScreenUpdating = True
End Sub
'+---------------------------------
'●印の箇所が異なるだけ。
ユーザーフォームに貼り付けます。
If文なしでWindows(ii)とやるとインデックスがコロコロ変わってだめです。
使えるかどうかについて責任は持てませんのであしからず！！
