マジックナンバーを排除した転記Part2
1 Part１は丸囲みを動かすマクロが出力シートのモジュールにイベントとして記載済のものを流用するため回りくどかったため、今回は入力シートにすべて書きこんでスッキリさせた。
2 シート構成など。
入力シートと出力シート２つ。出力シートは自動給紙設定済と手差し給紙設定済のもの。
入力シート内の左側に入力欄、右側にデータベース部分を配置。
出力シートは既定の印刷帳票。
入力シート左側で縦方向に入力していき、入力完了後Enterを押すだけでデータベース部分へ転記する。
3 コード
Option Explicit
'イベントの途中でエラーになったりステップ実行途中で抜けると、イベント発生不可のままになってしまうので、
'イベントが発生しなくなってしまったらイミディエイトウインドウで Application.EnableEvents = True とする。
'ここは電消入力シートモジュール
'電消入力シート
'入力項目のセルアドレス
Const adrs入力欄_集計年月 = "B2"
Const adrs入力欄_年分 = "C4"
Const adrs入力欄_台帳ER区分 = "C５"
Const adrs入力欄_台帳下4桁 = "C6"
Const adrs入力欄_バッチ下4桁 = "C7"
Const adrs入力欄_有還区分 = "C8"
Const adrs入力欄_SKoku区分 = "C9"
Const adrs入力欄_件数 = "C10"
Const adrs入力欄_誤り有無 = "C11"
Const adrs入力欄_連絡日 = "C12"
Const adrs入力欄_回付日 = "C13"
Const adrs入力欄_転記実行セルの1つ下 = "C15"
'電消入力シート
'データベース部分(一旦の転記してデータを溜めておく部分)
'列記号(columnLetter）ex.F10セルの「F」のこと。
Const Cletterデータベース_入力ID = "F"
Const Cletterデータベース_印刷対象 = "G"
Const Cletterデータベース_集計年 = "H"
Const Cletterデータベース_集計月 = "I"
Const Cletterデータベース_年分 = "J"
Const Cletterデータベース_台帳ER区分 = "K"
Const Cletterデータベース_台帳下4桁 = "L"
Const Cletterデータベース_バッチ下4桁 = "M"
Const Cletterデータベース_有還区分 = "N"
Const Cletterデータベース_SKoku区分 = "O"
Const Cletterデータベース_件数 = "P"
Const Cletterデータベース_誤り有無 = "Q"
Const Cletterデータベース_連絡日 = "R"
Const Cletterデータベース_回付日 = "S"
'セル番地
Const adrsデータベース_基点 = "Ｆ９"
'行番号
Const RNoデータベース_タイトル行番号 = 9
Const RNoデータベース_開始行番号 = 10
'印刷帳票(電消シート、電消手差しシート）
'SK区分の表内の丸囲みを配置するxy座標(自分で調べて数字を決める）
'------------------------------------------------
Const yoko内 = 300: Const yoko訂 = 350
Const tate内 = 150: Const tate訂 = 150
'------------------------------------------------
Const yoko後 = 300: Const yoko修 = 350
Const tate後 = 200: Const tate修 = 200
'------------------------------------------------
'セルアドレス
Const adrs印刷帳票_台帳ER区分 = "M8"
Const adrs印刷帳票_台帳下4桁 = "M10"
Const adrs印刷帳票_連絡日 = "D13"
Const adrs印刷帳票_集計年 = "D14"
Const adrs印刷帳票_集計月 = "F14"
Const adrs印刷帳票_バッチ下4桁 = "D15"
Const adrs印刷帳票_件数 = "E16"
Const adrs印刷帳票_整理年月日 = "D17"
Const adrs印刷帳票_年分 = "D18"
Const adrs印刷帳票_連絡件数 = "E20"
Const adrs印刷帳票_引受日 = "D23"
Const adrs印刷帳票_誤り有無 = "D26"
Const adrs印刷帳票_回付日 = "I13"
'■■■■■セレクションチェンジイベント■■■■■
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'イベント二重起動防止
Application.EnableEvents = False
'シート設定
Dim ws入力 As Worksheet: Set ws入力 = Me
'目的：BackTabボタン、Tabボタンで移動できるようにアクティブセルを制御
'ここはセル番地を直打ちした方が分かり易いと思う
Select Case Target.Address(0, 0)
'BackTab用
Case "B5"
Range("C4").Select
Case "B6"
Range("C5").Select
Case "B7"
Range("C6").Select
Case "B8"
Range("C7").Select
Case "B9"
Range("C8").Select
Case "B10"
Range("C9").Select
Case "B11"
Range("C10").Select
Case "B12"
Range("C11").Select
Case "B13"
Range("C12").Select
Case "B14"
Range("C13").Select
Case "B15"
Range("C14").Select
'Tab用
Case "D４"
Range("C5").Select
Case "D5"
Range("C6").Select
Case "D6"
Range("C7").Select
Case "D7"
Range("C8").Select
Case "D8"
Range("C9").Select
Case "D9"
Range("C10").Select
Case "D10"
Range("C11").Select
Case "D11"
Range("C12").Select
Case "D12"
Range("C13").Select
Case "D13"
Range("C14").Select
Case "D14"
Range("C15").Select
End Select
'目的：入力欄→DBへ1件転記
'「転記実行」と書いてあるセルでEnterキーを押した場合
If Target.Address(0, 0) = adrs入力欄_転記実行セルの1つ下 Then
'「ws入力の入力欄」から「ws入力のDB範囲」へ1件転記する
With ws入力
'注）ループ内で変数宣言しても宣言処理は1回しか実行されないので問題なし
Dim RNo転記先 As Long: RNo転記先 = .Range(Cletterデータベース_年分 & .Rows.Count).End(xlUp).Row + 1
'注）漢数字の〇と記号の〇は違うので全プロシージャで統一しておかないと正しく動作しない
.Range(Cletterデータベース_印刷対象 & RNo転記先).Value = "〇"
.Range(Cletterデータベース_集計年 & RNo転記先).Value = Left(.Range(adrs入力欄_集計年月).Value, 2)
.Range(Cletterデータベース_集計月 & RNo転記先).Value = Right(.Range(adrs入力欄_集計年月).Value, 2)
.Range(Cletterデータベース_年分 & RNo転記先).Value = .Range(adrs入力欄_年分).Value
.Range(Cletterデータベース_台帳ER区分 & RNo転記先).Value = .Range(adrs入力欄_台帳ER区分).Value
.Range(Cletterデータベース_台帳下4桁 & RNo転記先).Value = .Range(adrs入力欄_台帳下4桁).Value
.Range(Cletterデータベース_バッチ下4桁 & RNo転記先).Value = .Range(adrs入力欄_バッチ下4桁).Value
.Range(Cletterデータベース_有還区分 & RNo転記先).Value = .Range(adrs入力欄_有還区分).Value
.Range(Cletterデータベース_SKoku区分 & RNo転記先).Value = .Range(adrs入力欄_SKoku区分).Value
.Range(Cletterデータベース_件数 & RNo転記先).Value = .Range(adrs入力欄_件数).Value
.Range(Cletterデータベース_連絡日 & RNo転記先).Value = .Range(adrs入力欄_連絡日).Value
.Range(Cletterデータベース_回付日 & RNo転記先).Value = .Range(adrs入力欄_回付日).Value
'誤り有無は入力内容を「有」「無」に変換して転記
If .Range(adrs入力欄_誤り有無).Value = 0 Or .Range(adrs入力欄_誤り有無).Value = "" Then
.Range(Cletterデータベース_誤り有無 & RNo転記先).Value = "無"
Else
.Range(Cletterデータベース_誤り有無 & RNo転記先).Value = "有"
End If
'アクティブセルを移動して次件の入力をしやすくする
.Range(adrs入力欄_年分).Select
End With
End If
'イベント起動可に戻す
Application.EnableEvents = True
End Sub
'■■■■■ダブルクリックイベント■■■■■
'ダブルクリックしたセルが特定の範囲にあった場合
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'ダブルクリックしたセルの列記号で場合分け
Select Case Split(Target.Address, "$")(1)
'ダブルクリックしたセルがG列だったら
Case "G"
'ダブルクリックしても編集モードにしない
Cancel = True
'ダブルクリックしたセルの値で場合分け
Select Case Target.Value
'セルの値が空欄だったら”〇”を入力
Case ""
Target.Value = "〇"
'セルの値が”〇”だったら空欄にする
Case "〇", "印刷済"
Target.Value = ""
End Select
'ダブルクリックいたセルがQ列だったら
Case "Q"
'ダブルクリックしても編集モードにしない
Cancel = True
'ダブルクリックしたセルの有と無を相互に入れ替える
Select Case Target.Value
Case "無"
Target.Value = "有"
Case "有"
Target.Value = "有"
End Select
End Select
End Sub
'■■■■■一括印刷ボタン■■■■■
Sub btn電子データ整理表へ転記しながら一括印刷()
Application.EnableEvents = False
'シート設定
Dim ws電消入力 As Worksheet: Set ws電消入力 = ThisWorkbook.Worksheets("電消入力")
Dim ws電消 As Worksheet: Set ws電消 = ThisWorkbook.Worksheets("電消")
Dim ws電消手差し As Worksheet: Set ws電消手差し = ThisWorkbook.Worksheets("電消手差し")
'目的：手差し用紙をセットしたか確認メッセージを表示する
'表示メッセージ内容
Dim m As String: m = ""
m = m & "マイナス(有還区分２）は手差し給紙です。" & vbNewLine
m = m & "手差し用紙をセットしましたか？" & vbNewLine
m = m & "「印刷対象」列に〇が入っている行を印刷します。" & vbNewLine
m = m & "印刷実行しますか？" & vbNewLine
'手差し用紙をセットしていなかったら印刷をキャンセル。ボタン選択のデフォルト位置はキャンセル
If MsgBox(m, vbOKCancel + vbDefaultButton2) = vbCancel Then
MsgBox "印刷をキャンセルします"
Exit Sub
End If
'目的：「転記（DB→出力用帳票へ）して印刷」をループ
Dim R As Long
For R = RNoデータベース_開始行番号 To ws電消入力.Range(Cletterデータベース_印刷対象 & ws電消.Rows.Count).End(xlUp).Row
'印刷対象列に〇がないときは転記と印刷をスキップする
If ws電消入力.Range(Cletterデータベース_印刷対象 & R).Value <> "〇" Then GoTo continueNextFor
'目的：印刷対象シートを決める
'今回は２つの帳票は全く同じだが、手動で給紙方法だけ設定しておく。マクロ実行前に片方を自動給紙、もう片方を手差し給紙で設定保存しておく。
Dim ws印刷対象 As Worksheet
'有還区分が「２」だったら
If ws電消入力.Range(Cletterデータベース_有還区分 & R).Value = 2 Then
Set ws印刷対象 = ws電消手差し
'有還区分が「２」以外なら
Else
Set ws印刷対象 = ws電消
End If
'転記（ＤＢ→出力帳票）して印刷
With ws印刷対象
'丸囲みを動かす
'丸囲みの図形名はマクロ記録で動かして調べること
Select Case ws電消入力.Range(Cletterデータベース_有還区分 & R).Value
Case 0
.Shapes.Range(Array("Oval 1")).Left = yoko内
.Shapes.Range(Array("Oval 1")).Top = tate内
Case 1
.Shapes.Range(Array("Oval 1")).Left = yoko後
.Shapes.Range(Array("Oval 1")).Top = tate後
Case 2
.Shapes.Range(Array("Oval 1")).Left = yoko訂
.Shapes.Range(Array("Oval 1")).Top = tate訂
Case 3
.Shapes.Range(Array("Oval 1")).Left = yoko修
.Shapes.Range(Array("Oval 1")).Top = tate修
End Select
.Range(adrs印刷帳票_台帳ER区分).Value = ws電消入力.Range(Cletterデータベース_台帳ER区分 & R).Value
.Range(adrs印刷帳票_台帳下4桁).Value = ws電消入力.Range(Cletterデータベース_台帳下4桁 & R).Value
.Range(adrs印刷帳票_連絡日).Value = ws電消入力.Range(Cletterデータベース_連絡日 & R).Value
.Range(adrs印刷帳票_集計年).Value = ws電消入力.Range(Cletterデータベース_集計年 & R).Value
.Range(adrs印刷帳票_集計月).Value = ws電消入力.Range(Cletterデータベース_集計月 & R).Value
.Range(adrs印刷帳票_台帳下4桁).Value = ws電消入力.Range(Cletterデータベース_バッチ下4桁 & R).Value
.Range(adrs印刷帳票_件数).Value = ws電消入力.Range(Cletterデータベース_件数 & R).Value
.Range(adrs印刷帳票_整理年月日).Value = ws電消入力.Range(Cletterデータベース_連絡日 & R).Value
.Range(adrs印刷帳票_年分).Value = ws電消入力.Range(Cletterデータベース_年分 & R).Value
.Range(adrs印刷帳票_連絡件数).Value = ws電消入力.Range(Cletterデータベース_件数 & R).Value
.Range(adrs印刷帳票_引受日).Value = ws電消入力.Range(Cletterデータベース_連絡日 & R).Value
.Range(adrs印刷帳票_誤り有無).Value = ws電消入力.Range(Cletterデータベース_誤り有無 & R).Value
.Range(adrs印刷帳票_回付日).Value = ws電消入力.Range(Cletterデータベース_回付日 & R).Value
'印刷(テストして問題なければprintpreviewをprintoutに書き換えて使用する）
.PrintPreview
'印刷対象列の値を「〇」から印刷済に変更
ws電消入力.Range(Cletterデータベース_印刷対象 & R).Value = "印刷済"
End With
'Forループを１回スキップしたいときはここに飛んでくる
continueNextFor:
Next R
MsgBox "印刷要求完了"
Application.EnableEvents = True
End Sub
'■■■■■DB初期化ボタン■■■■■
'注意：ボタン登録時別シートモジュールのマクロは見えないのでシート名とモジュール名を手打ちして登録する。
Sub btn電消入力シートのDB部分クリア()
'イベント二重起動防止
Application.EnableEvents = False
'データベース初期化
Dim ws電消入力 As Worksheet: Set ws電消入力 = ThisWorkbook.Worksheets("電消入力")
ws電消入力.Range(adrsデータベース_基点).CurrentRegion.Offset(1, 1).ClearContents
Application.EnableEvents = True
End Sub
4
