'========================================================================================= ' 180 指定セル範囲を他の全てのワークシートにコピーする '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードを含んでいます。(概ね下半分) ' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。(概ね上半分) '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim 配列 As Variant '★★★ Dim セル範囲 As String '★★★ Dim タイトル As String Dim スタイル As Long Dim メッセージ As String Dim 応答 As Variant Dim 操作環境 As String '========================================================================================= Private Sub 指定セル範囲を他の全てのワークシートにコピーする() 配列 = Array("Sheet2", "Sheet3", "Sheet4") Sheets(配列).FillAcrossSheets Worksheets("Sheet2").Range(セル範囲) '★★★ End Sub '========================================================================================= '----------------------------------------------------------------------------------------- Sub おためしマクロ() おためしメッセージを表示する ' セル範囲 = "A1:B3" '★★★ 指定セル範囲を他の全てのワークシートにコピーする '★★★ ' おためしメッセージを表示する2 End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する() ウィンドウを左右に並べて表示する タイトル = "500連発 第2弾 サンプルマクロ" スタイル = 64 'vbInformation メッセージ = "Sheet2 の A1:B3 セルの内容を、" & Chr(13) & Chr(13) & _ "Sheet3 と Sheet4 の同じ領域に、" & Chr(13) & Chr(13) & _ "FillAcrossSheetsメソッドを使って、コピーします" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する2() メッセージ = "コピーしました。画面を元に戻します" 応答 = MsgBox(メッセージ, スタイル, タイトル) ウィンドウを戻す End Sub '----------------------------------------------------------------------------------------- Private Sub ウィンドウを左右に並べて表示する() 操作環境 = Worksheets("Title").Range("L1").Value '操作環境(Win or Mac)を取得する ActiveWindow.NewWindow Sheets("Sheet4").Select Cells.Clear ActiveWindow.NewWindow Sheets("Sheet3").Select Cells.Clear ActiveWindow.NewWindow Sheets("Sheet2").Select Windows.Arrange ArrangeStyle:=xlVertical If 操作環境 <> "mac" Then 'Macintosh版でないなら Windows("180.XLS:1").Activate ActiveWindow.WindowState = xlMinimized '最小化する Windows.Arrange ArrangeStyle:=xlVertical End If Worksheets("Sheet2").Activate '動きをわかりやすくするため Range("A1:B3").Select '動きをわかりやすくするために選択する End Sub '----------------------------------------------------------------------------------------- Private Sub ウィンドウを戻す() ActiveWindow.Close ActiveWindow.Close ActiveWindow.Close ActiveWindow.WindowState = xlMaximized ActiveWindow.DisplayHeadings = False Range("P17").Select ActiveWindow.FreezePanes = True End Sub '----------------------------------------------------------------------------------------- Sub Auto_Close() Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない ActiveWorkbook.Close '現在開いているブックを閉じる End Sub '-----------------------------------------------------------------------------------------