エクセルVBAアクティブセルの利用。印刷の範囲を指定！封筒宛名印刷

今回のテーマのコード作成のポイントは

印刷の範囲指定を簡単に設定できるようにする。簡単に範囲を修正・変更できるようにすることです。

1. 印刷の始点終点の指定方法はアクティブセルのRangeオブジェクトを利用する。
2. 昇順・降順を考えたコード組み立てを行う。
3. 印刷のためのコードは、単独印刷での「単独印刷」プロシージャーを利用します。

Private Sub アクティブプリンター_Click()
宛名印刷設定.アクティブプリンター.Caption = Application.ActivePrinter
End Sub

Private Sub 宛名リスト表示_Click()
Worksheets(“宛名リスト”).Select
End Sub

Private Sub 始点入力_Click()
Module4.宛名始点選択
End Sub

Private Sub 始点クリア_Click()
宛名印刷設定.宛名始点A.Caption = “”
宛名印刷設定.宛名始点A.BackColor = &H8000000F
shiR = 0
End Sub

Private Sub 終点入力_Click()
Module4.宛名終点選択
End Sub

Private Sub 終点クリア_Click()
宛名印刷設定.宛名終点A.Caption = “”
宛名印刷設定.宛名終点A.BackColor = &H8000000F
shuR = 0
End Sub

Private Sub 印刷範囲確認_Click()
Worksheets(“宛先”).Select
If 宛名印刷設定.宛名始点A.Caption = “” Then
MsgBox “宛名始点が指定されていません。”, vbOKOnly, “メッセージ”
宛名印刷設定.印刷範囲1.Caption = “”
Exit Sub
End If
If 宛名印刷設定.宛名終点A.Caption = “” Then
MsgBox “宛名終点が指定されていません。”, vbOKOnly, “メッセージ”
宛名印刷設定.印刷範囲1.Caption = “”
Exit Sub
End If
宛名印刷設定.印刷範囲1.Caption = “「” & 宛名印刷設定.宛名始点A.Caption & “」から「” & 宛名印刷設定.宛名終点A.Caption & “」まで”
宛名印刷設定.印刷範囲2.Caption = Abs(shuR – shiR) + 1 & “件分を印刷します。”
Module4.連続印刷PV
End Sub

Private Sub 連続印刷_Click()
Module4.連続印刷開始
End Sub

Public STY As Variant
Public shiR As Long, shuR As Long

Sub 宛名始点選択()

Worksheets(“宛名リスト”).Select
宛名印刷設定.宛名始点A.Caption = Range(“B” & ActiveCell.Row)
宛名印刷設定.宛名始点A.BackColor = &HFFFFC0
shiR = ActiveCell.Row

End Sub

Sub 宛名終点選択()

Worksheets(“宛名リスト”).Select
宛名印刷設定.宛名終点A.Caption = Range(“B” & ActiveCell.Row)
宛名印刷設定.宛名終点A.BackColor = &HFFFFC0
shuR = ActiveCell.Row

End Sub

Sub 連続印刷PV()

Dim ans As Integer
Worksheets(“宛名リスト”).Select
STY = 宛名印刷設定.TP_no.Caption

　　If STY = “” Then
　　　　MsgBox “封筒サイズが指定されていません。”, vbOKOnly, “メッセージ”
　　　　Exit Sub
　　End If

　　If shuR >= shiR Then

　　　　For s = shiR To shuR
　　　　　　Worksheets(“宛名リスト”).Select
　　　　　　Range(“B” & s).Select
　　　　　　Module1.単独印刷
　　　　　　Module1.発送便記入
　　　　　　ans = MsgBox(“プレビュー画面に切替えしますか？”, vbYesNo + vbQuestion, “チェック”)
　　　　　　If ans = vbYes Then
　　　　　　　　Worksheets(“宛先”).PrintPreview
　　　　　　Else
　　　　　　　　MsgBox “終了します”
　　　　　　　　Exit Sub
　　　　　　End If
　　　　Next s

　　ElseIf shuR < shiR Then
　　　　For t = shiR To shuR Step -1
　　　　　　Worksheets(“宛名リスト”).Select
　　　　　　Range(“B” & t).Select
　　　　　　Module1.単独印刷
　　　　　　Module1.発送便記入
　　　　　　ans = MsgBox(“プレビュー画面に切替えしますか？”, vbYesNo + vbQuestion, “チェック”)
　　　　　　If ans = vbYes Then
　　　　　　　　Worksheets(“宛先”).PrintPreview
　　　　　　Else
　　　　　　　　MsgBox “終了します”
　　　　　　　　Exit Sub
　　　　　　End If
　　　　Next t
　　End If

End Sub

Sub 連続印刷開始()

Worksheets(“宛名リスト”).Select
STY = 宛名印刷設定.TP_no.Caption

　　If STY = “” Then
　　　　MsgBox “封筒サイズが指定されていません。”, vbOKOnly, “メッセージ”
　　　　Exit Sub
　　End If

　　If shuR >= shiR Then

　　　　For s = shiR To shuR
　　　　　　Worksheets(“宛名リスト”).Select
　　　　　　Range(“B” & s).Select
　　　　　　Module1.単独印刷
　　　　　　Module1.発送便記入
　　　　　　Worksheets(“宛先”).PrintOut
　　　　Next s

　　ElseIf shuR < shiR Then
　　　　For t = shiR To shuR Step -1
　　　　　　Worksheets(“宛名リスト”).Select
　　　　　　Range(“B” & t).Select
　　　　　　Module1.単独印刷
　　　　　　Module1.発送便記入
　　　　　　Worksheets(“宛先”).PrintOut
　　　　Next t
　　End If

End Sub