根を詰め過ぎてミスが出始めた・・・

昨夜出来上がった元帳印刷ソフト・・・

勘定科目全てで利用出来るよう設定している・・・が

何せ科目が多いからこれも大変だぁ・・・

只、銀行勘定帳と金銭出納帳は少し手をくわえなければいけないなぁ・・・



今日は根を詰め過ぎたから操作ミスが出始めた・・・もう止めておこう・・・

やはり手直しは、大変だぁ～・・・


脳味噌が疲れてしまったから、夕方までに回復させないと・・・

第二部の仕事でミスが出てしまったら大変だぁ・・・終了ぉぉぉぉ～！

こんな複雑なマクロ初めて創ったぁ～！

完_成だ ^ぁ～！ヽ(^o^)丿

昨夜までかかったが、ついに今までで最高のマクロが完成した・・・

これで、データーさえ入力し印刷ボタンを押せば勝手に斜め罫線を入れて印刷する訳だ！

　←この入力画面にデータを入れ右上の印刷ボタンを押すだけ！

今までここまで複雑なマクロを完成させた事は無かった・・・

たまたま夜が二日続きで休みだったから出来たようなものだ・・・

これから月末が非常に楽に成る・・・有りがたい事だ・・・



参考までに、VBAマクロを添付して置きますので参考に成れば利用してみて下さい
※素人が作った物なので不要な部分があるかと思いますがご了承ください。

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　

Sub 元帳奇数頁印刷()
'
' 元帳奇数頁印刷 Macro
'

'
　If MsgBox("ここは奇数頁の印刷です！間違いありませんか？", vbOKCancel, "印刷確認") = vbOK Then
　　Sheets("元帳用紙(奇数頁)").Select
　　Range("C7:G34").Select
　　Selection.Copy
　　Sheets("印刷-元帳用紙(奇数頁)").Select
　　Range("A7:C34").Select
　　Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
　　　　SkipBlanks:=False, Transpose:=False
　　Range("A7").Select
　　Sheets("元帳用紙(奇数頁)").Select
　　Application.CutCopyMode = False
　　ActiveWindow.SmallScroll Down:=-14
　　Range("I7:J34").Select
　　Selection.Copy
　　Sheets("印刷-元帳用紙(奇数頁)").Select
　　Range("G7:H34").Select
　　Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
　　　　SkipBlanks:=False, Transpose:=False
　　Range("G7:H7").Select
　　Sheets("元帳用紙(奇数頁)").Select
　　ActiveWindow.SmallScroll Down:=-16
　　Application.CutCopyMode = False
　　Range("L7:M34").Select
　　Selection.Copy
　　Sheets("印刷-元帳用紙(奇数頁)").Select
　　Range("J7:K34").Select
　　Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
　　　　SkipBlanks:=False, Transpose:=False
　　Range("J7:K7").Select
　 Sheets("元帳用紙(奇数頁)").Select
　　ActiveWindow.SmallScroll Down:=-10
　　Application.CutCopyMode = False
　　Range("C7").Select
　　Worksheets("印刷-元帳用紙(奇数頁)").Activate
　　シート名 = "印刷-元帳用紙(奇数頁)"
　　セル範囲 = "C7"
　　Application.Goto Worksheets(シート名).Range(セル範囲)
　　　　Range("C7").CurrentRegion.Select '左上セル基点にアクティブセル領域選択
　　　　行 = Selection.Row '　　〃　の行番号
　　　　下 = 行 + Selection.Rows.Count 'アクティブセルの下端の次の行番号
　　　　Range(Cells(下, 1), Cells(下, 1)).Select
　　　　左 = 3 '選択する範囲の左端セルの列番号
　　　　右 = 5 '　　　〃　　　右端　〃　列番号
　　　　セル下 = 34 '　　　〃　　　下端　〃　行番号
　　Range(Cells(下, 左), Cells(セル下, 右)).Select
　　With Selection
　　　　.HorizontalAlignment = xlDistributed
　　　　.VerticalAlignment = xlCenter
　　　　.Orientation = 0
　　　　.AddIndent = False
　　　　.IndentLevel = 0
　　　　.ShrinkToFit = False
　　　　.ReadingOrder = xlContext
　　　　.MergeCells = True
　　End With
　　Selection.Borders(xlDiagonalDown).LineStyle = xlNone
　　With Selection.Borders(xlDiagonalUp)
　　　　.LineStyle = xlContinuous
　　　　.Color = -16776961
　　　　.TintAndShade = 0
　　　　.Weight = xlThin
　　End With
　　Selection.Borders(xlEdgeLeft).LineStyle = xlNone
　　Selection.Borders(xlEdgeTop).LineStyle = xlNone
　　With Selection.Borders(xlEdgeBottom)
　　　　.LineStyle = xlContinuous
　　　　.Color = -16776961
　　　　.TintAndShade = 0
　　　　.Weight = xlThin
　　End With
　　Selection.Borders(xlEdgeRight).LineStyle = xlNone
　　Selection.Borders(xlInsideVertical).LineStyle = xlNone
　　Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
　　Application.ActivePrinter = "EPSON PX-201(ネットワーク) on Ne02:"
　　ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
　　Worksheets("印刷-元帳用紙(奇数頁)").Activate
　　Application.Goto Reference:=Worksheets("印刷-元帳用紙(奇数頁)").Range("A7:K34"), scroll:=True
　　Selection.ClearContents
　　左 = 3 '罫線消去範囲の左端
　　上 = 7 '上端
　　右 = 5 '右端
　　下 = 34 '下端
　　Sheets("印刷-元帳用紙(奇数頁)").Select
　　　　Range(Cells(上, 左), Cells(下, 右)).Select '消去する範囲を選択
　　Selection.Borders(xlDiagonalDown).LineStyle = xlNone
　　Selection.Borders(xlDiagonalUp).LineStyle = xlNone
　　Selection.Borders(xlEdgeLeft).LineStyle = xlNone
　　Selection.Borders(xlEdgeTop).LineStyle = xlNone
　　Selection.Borders(xlEdgeBottom).LineStyle = xlNone
　　Selection.Borders(xlEdgeRight).LineStyle = xlNone
　　Selection.Borders(xlInsideVertical).LineStyle = xlNone
　　Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
　　Range("C7:E34").UnMerge
　　Range("D7:E7").Merge (True)
　　Range("D8:E8").Merge (True)
　　Range("D9:E9").Merge (True)
　　Range("D10:E10").Merge (True)
　　Range("D11:E11").Merge (True)
　　Range("D12:E12").Merge (True)
　　Range("D13:E13").Merge (True)
　　Range("D14:E14").Merge (True)
　　Range("D15:E15").Merge (True)
　　Range("D16:E16").Merge (True)
　　Range("D17:E17").Merge (True)
　　Range("D18:E18").Merge (True)
　　Range("D19:E19").Merge (True)
　　Range("D20:E20").Merge (True)
　　Range("D21:E21").Merge (True)
　　Range("D22:E22").Merge (True)
　　Range("D23:E23").Merge (True)
　　Range("D24:E24").Merge (True)
　　Range("D25:E25").Merge (True)
　　Range("D26:E26").Merge (True)
　　Range("D27:E27").Merge (True)
　　Range("D28:E28").Merge (True)
　　Range("D29:E29").Merge (True)
　　Range("D30:E30").Merge (True)
　　Range("D31:E31").Merge (True)
　　Range("D32:E32").Merge (True)
　　Range("D33:E33").Merge (True)
　　Range("D34:E34").Merge (True)
　　Range("C34:E34").Select
　　Selection.Borders(xlDiagonalDown).LineStyle = xlNone
　　Selection.Borders(xlDiagonalUp).LineStyle = xlNone
　　Selection.Borders(xlEdgeLeft).LineStyle = xlNone
　　Selection.Borders(xlEdgeTop).LineStyle = xlNone
　　With Selection.Borders(xlEdgeBottom)
　　　　.LineStyle = xlContinuous
　　　　.Color = -16776961
　　　　.TintAndShade = 0
　　　　.Weight = xlThin
　　End With
　　Selection.Borders(xlEdgeRight).LineStyle = xlNone
　　Selection.Borders(xlInsideVertical).LineStyle = xlNone
　　Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
　　Sheets("元帳用紙(奇数頁)").Select
　End If
End Sub