|
|
|
2023年01月24日
カテゴリ：Excel.vba
前提条件は次のとおり Excel2010用,シートは上下に２ウィンドウ整列済み。 Excel2010はmdiだが2013から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)とやるとインデックスがコロコロ変わってだめです。 使えるかどうかについて責任は持てませんのであしからず！！
お気に入りの記事を「いいね！」で応援しよう
最終更新日
2023年01月24日 16時54分39秒
コメント(0) | コメントを書く |
