'========================================================================================= ' 106 セルの仕切線・最下線を設定する '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードを含んでいます。(概ね下半分) ' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。(概ね上半分) '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim 左 As Integer '★★★ Dim 上 As Long '★★★ Dim 右 As Integer '★★★ Dim 下 As Long '★★★ Dim 線種 As Long '★★★ Dim タイトル As String Dim スタイル As Long Dim メッセージ As String Dim 共通メッセージ As String Dim 応答 As Variant '========================================================================================= Private Sub セルの仕切線を設定する() Range(Cells(上, 左), Cells(下, 右)).Borders(xlLeft).Weight = 線種 End Sub '----------------------------------------------------------------------------------------- Private Sub セルの最下線を設定する() Range(Cells(上, 左), Cells(下, 右)).Borders(xlBottom).Weight = 線種 End Sub '----------------------------------------------------------------------------------------- Private Sub セルの外枠線を設定する() Range(Cells(上, 左), Cells(下, 右)).BorderAround Weight:=線種 End Sub '========================================================================================= '----------------------------------------------------------------------------------------- Sub おためしマクロ() Sheet1を準備する ' 左 = 3 '★★★ 上 = 5 '★★★ 右 = 6 '★★★ 下 = 10 '★★★ 線種 = xlThin '★★★ おためしメッセージを表示する セルの最下線を設定する '★★★ ' 線種 = xlHairline '★★★ おためしメッセージを表示する2 セルの仕切線を設定する '★★★ ' 線種 = xlThick '★★★ おためしメッセージを表示する3 セルの外枠線を設定する '★★★ ' 左 = 5 '★★★ 上 = 5 '★★★ 右 = 5 '★★★ 下 = 10 '★★★ 線種 = xlMedium '★★★ おためしメッセージを表示する4 セルの仕切線を設定する '★★★ ' おためしメッセージを表示する5 ActiveWindow.SelectedSheets.PrintPreview '印刷プレビュー Worksheets("Title").Activate Range("P17").Select 'カーソルを定位置へ End Sub '----------------------------------------------------------------------------------------- Private Sub Sheet1を準備する() Worksheets("Sheet1").Cells.Clear 'クリアしておく Worksheets("Sheet1").Cells(11, 1) = "." '印刷プレビューを見やすくするため Worksheets("Sheet1").Cells(1, 7) = "." Worksheets("Sheet1").Activate Range("A1").Select 'わかりやすくするためにカーソルを移動する End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する() タイトル = "500連発 第2弾 サンプルマクロ" スタイル = 64 'vbInformation 共通メッセージ = 左 & "列 " & 上 & "行を 左上とし、" & _ 右 & "列 " & 下 & "行を 右下とするセル範囲に、" メッセージ = 共通メッセージ & "最下線を設定します" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する2() メッセージ = 共通メッセージ & "仕切線を設定します" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する3() メッセージ = 共通メッセージ & "外枠線を設定します" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する4() メッセージ = 左 & "列 " & 上 & "行を 左上とし、" & _ 右 & "列 " & 下 & "行を 右下とするセル範囲に、" & _ "仕切線を設定します" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Private Sub おためしメッセージを表示する5() メッセージ = "うまく引けたか、印刷プレビューします。" & Chr(13) & Chr(13) & _ " " & Chr(13) & Chr(13) & _ "見終ったら [閉じる]ボタンをクリックしてください" 応答 = MsgBox(メッセージ, スタイル, タイトル) End Sub '----------------------------------------------------------------------------------------- Sub Auto_Close() Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない ActiveWorkbook.Close '現在開いているブックを閉じる End Sub '-----------------------------------------------------------------------------------------