Excel2010.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 = TrueEnd 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 = TrueEnd Sub'+---------------------------------'●印の箇所が異なるだけ。ユーザーフォームに貼り付けます。If文なしでWindows(ii)とやるとインデックスがコロコロ変わってだめです。使えるかどうかについて責任は持てませんのであしからず！！
出産・子育て
ファッション
美容・コスメ
健康・ダイエット
生活・インテリア
料理・食べ物
ドリンク・お酒
ペット
趣味・ゲーム
映画・ＴＶ
音楽
読書・コミック
旅行・海外情報
園芸
スポーツ
アウトドア・釣り
車・バイク
パソコン・家電
そのほか
すべてのジャンル
