【窓付き封筒】連続データ貼り付け→印刷マクロ（３つ折り線付き）作ってみた

当ページのリンクには広告が含まれています。

2023年8月24日

システム開発メーカー勤務

窓付き封筒に入れるA4用紙への印刷マクロってどうやって作ったらいいの？折り方もわからないよ

本記事の内容

窓付き封筒に入れるA4用紙へ住所等のデータを連続貼り付け→印刷マクロ（3つ折り線も印字）

本記事の根拠

私は中小企業の情シス（2人部署）に勤めてまもなく10年目になります

本記事を読むメリット

窓付き封筒に入れる印刷物のプリントアウトの効率化が期待できます。

それでは本題に入ります。

筆者はこんな人

中小企業の小規模情シス（総員2名）勤務歴まもなく10年目。
特技はSSD換装。

トランスフォーマーや漫画が大好きなオタクでもあります。
車１台は買えるくらいトランスフォーマーに注ぎ込んできました。

職場で日経パソコンや日経コンピュータを読み漁る日々。
おかげで、最新のパソコン機器やデバイスの知識は常にアップデート状態。

私が雑誌に読みふける一方で、取引先のシステム開発メーカーの方はプログラム作成・修正に追われている。
次第に、システム開発メーカーの中堅の方を憂うようになる。

システム開発屋さんから情シスに転職したい方の手助けをするためにブログを立ち上げた。
狙うは『中小企業の小規模情シス』。

一度きりしかない人生を少しでもより良いものにしませんか？

窓付き封筒の印刷マクロ（サンプルデータ付き）

下記のコードをコピペして実行すると、4枚プリントアウトされますのでご注意ください。
また、2回目以降の処理は『二回目以降用印刷マクロ』をご使用ください。

Sub 窓付き封筒用テンプレート作成と印刷()


'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
'※                                                                  
'※　　　本マクロを実行すると、4枚プリントアウトされますのでご注意ください 　　　※
'※                                                                  
'※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※



'画面更新オフ(マクロの処理速度アップのため)

    Application.ScreenUpdating = False



'----------【テストデータ（参考程度）】----------

'※項目追加する場合は、後述しているデータ転記記述に追記してください※


    With Sheets.Add(After:=Sheets(Sheets.Count)) '印刷データシートの追加
       .Name = "印刷データ"
    End With

    Range("A1").Value = "支払先"
    Range("B1").Value = "振込額"
    Range("C1").Value = "郵便番号"
    Range("D1").Value = "住所1"
    Range("E1").Value = "住所2"
    Range("F1").Value = "登録番号"

    Range("A2").Value = "（株）テスト1"
    Range("B2").Value = "100"
    Range("C2").Value = "123-4567"
    Range("D2").Value = "〇〇県〇〇市〇〇町"
    Range("E2").Value = "〇〇ビル〇〇Ｆ"
    Range("F2").Value = "〇〇〇〇〇〇〇〇"

    Range("A3").Value = "（株）テスト2"
    Range("B3").Value = "200"
    Range("C3").Value = "123-4567"
    Range("D3").Value = "〇〇県〇〇市〇〇町"
    Range("E3").Value = "△△マンション■■号室"
    Range("F3").Value = "〇〇〇〇〇〇〇〇"

'----------【テストデータ（参考程度）】----------


'----------【印刷テンプレート作成開始】----------


    With Sheets.Add(After:=Sheets(Sheets.Count)) '印刷画面シートの追加
        .Name = "印刷画面"
    End With

    Cells.Select
    With Selection.Font 'セル全体のフォントを『ＭＳ　明朝』にセット
        .Name = "ＭＳ 明朝"
    End With


'△▼△▼△▼△▼△▼自社情報入力欄△▼△▼△▼△▼△▼△▼

        '【備考】左側に空白をセットしていますが、
        '封筒の窓の大きさや項目の長さに合わせて調整してください。
                                                  
'会社名
    Range("G8").Value = "　　　　　　　 〇〇株式会社"
    
'郵便番号
    Range("G10").Value = "　　〒〇〇〇-〇〇〇〇"

'住所1
    Range("G11").Value = "　　〇〇県〇〇市〇〇町〇〇番地"

'電話番号
    Range("G12").Value = "　　TEL:〇〇〇〇-〇〇-〇〇〇〇"

'インボイス登録番号
    Range("G13").Value = "　　登録番号:〇〇〇〇〇〇〇〇"
    

'△▼△▼△▼△▼△▼自社情報入力欄△▼△▼△▼△▼△▼△▼


'折れ目線を引く
    '手順1：A4用紙の下をこの罫線に合わせて谷折り
    '手順2：この罫線に沿って山折り

    Cells(20, 1).Select 'A列20行目
    With Selection.Borders(xlEdgeBottom) '罫線下線
        .LineStyle = xlContinuous '実線
        .ThemeColor = 1
        .TintAndShade = -0.14996795556505 '薄い灰色系
        .Weight = xlThin '細
    End With

    Cells(20, 11).Select 'K列20行目
    With Selection.Borders(xlEdgeBottom) '罫線下線
        .LineStyle = xlContinuous '実線
        .ThemeColor = 1
        .TintAndShade = -0.14996795556505 '薄い灰色系
        .Weight = xlThin
    End With


'行の高さの設定

    Range("1:2").RowHeight = 24
    Range("3:52").RowHeight = 14.25
    Rows(17).RowHeight = 17.25
    Rows(29).RowHeight = 25
    
'列の幅の設定

    Range("A:A", "K:K").ColumnWidth = 2.56
    Range("B:B", "J:J").ColumnWidth = 1
    Range("C:I").ColumnWidth = 9.44

'明細部の作成

    With Range("C17:I17")
        .HorizontalAlignment = xlCenter
        .Merge
    End With
    
    Range("C17").Value = "○○○のご案内"
    Range("C17").Font.Size = 14

    Range("C22").Value = "拝啓　時下益々ご清栄のこととお慶び申し上げます。"
    Range("C22").Font.Size = 10.5

    Range("C23").Value = "さて、当月の○○は下記の通りですので、ご確認いただきますよう、お願い申し上げます。　敬具"
    Range("C23").Font.Size = 10.5

    Range("C29").Value = "○○金額合計"
    Range("C29").Font.Size = 12

    Range("E29").Font.Size = 15

    Range("F29").Value = "円也"
    Range("F29").Font.Size = 11
    Range("F29").HorizontalAlignment = xlLeft
    

'金額欄の罫線を引く

    Range("C29:F29").Borders(xlEdgeTop).Weight = xlThick
    Range("C29:F29").Borders(xlEdgeBottom).Weight = xlThick
    Range("C29:F29").Borders(xlEdgeLeft).Weight = xlThick
    Range("C29:F29").Borders(xlEdgeRight).Weight = xlThick
    
    

'----------【印刷テンプレート作成完了】----------



'----------【データ貼付準備開始】----------

    
'最終行の取得

    Sheets("印刷データ").Select
    
    Dim LastRowNum As Long                          '最終行を取得する変数設定
    LastRowNum = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得(空白セルがない前提)
    

'印刷枚数の表示

    mes = MsgBox("印刷枚数は控えも合わせて" & (LastRowNum - 1) * 2 & "枚です", vbYes, "確認")
    
    Sheets("印刷画面").Select

'余白の設定

    With ActiveSheet.PageSetup
      .TopMargin = Application.CentimetersToPoints(0)
      .BottomMargin = Application.CentimetersToPoints(2.9)
      .LeftMargin = Application.CentimetersToPoints(0)
      .RightMargin = Application.CentimetersToPoints(0)
      .HeaderMargin = Application.CentimetersToPoints(0.8)
      .FooterMargin = Application.CentimetersToPoints(0.8)
      .CenterHorizontally = True
      .CenterVertically = True
    End With
    
    
    
'----------【データ貼付準備終了】----------

    
    
'----------テンプレートへのデータ張り付け&印刷処理繰り返し開始----------'
    
    Dim n As Long
    For n = 2 To LastRowNum
            
      Range("C2").Value = "　　〒" & Worksheets("印刷データ").Cells(n, 3).Value '郵便番号
      Range("C3").Value = "　　" & Worksheets("印刷データ").Cells(n, 4).Value '住所1
      Range("C4").Value = "　　" & Worksheets("印刷データ").Cells(n, 5).Value '住所2
      Range("C5").Value = "　　" & Worksheets("印刷データ").Cells(n, 1).Value & "　ご担当者様" '宛先名
      Range("C6").Value = "　　登録番号:" & Worksheets("印刷データ").Cells(n, 6).Value '登録番号
      Range("E29").Value = Worksheets("印刷データ").Cells(n, 2).Value '〇〇金額
    
    
'印刷（送付分と控え分を印刷）

      Range("A1:K52").Select
      Selection.PrintOut Copies:=1, Collate:=True

      Range("C17").Value = "○○○のご案内(控)"
      Selection.PrintOut Copies:=1, Collate:=True

      Range("C17").Value = "○○○のご案内"

'次のデータへ
    Next n
    
'----------テンプレートへのデータ張り付け&印刷処理終了----------'
 
    fin = MsgBox("プリンターへの送信完了しました", vbYes, "完了")
    Sheets("印刷画面").Select
    
    
'画面更新オンに戻しておく

    Application.ScreenUpdating = True
    
    
End Sub
Sub 二回目以降用印刷マクロ()


'画面更新オフ（処理スピードアップの為）

    Application.ScreenUpdating = False


'△▼△▼△▼△▼△▼データ貼付準備開始△▼△▼△▼△▼△▼

'最終行の取得
    Sheets("印刷データ").Select
    
    Dim LastRowNum As Long                          '最終行を取得する変数設定
    LastRowNum = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得(空白セルがない前提)
    

'印刷枚数の表示
    mes = MsgBox("印刷枚数は控えも合わせて" & (LastRowNum - 1) * 2 & "枚です", vbYes, "確認")
    
    
'△▼△▼△▼△▼△▼データ貼付準備完了△▼△▼△▼△▼△▼


    
 
'----------テンプレートへのデータ張り付け&印刷処理繰り返し開始----------'

    Sheets("印刷画面").Select
    
    Dim n As Long
    For n = 2 To LastRowNum
            
      Range("C2").Value = "　　〒" & Worksheets("印刷データ").Cells(n, 3).Value '郵便番号
      Range("C3").Value = "　　" & Worksheets("印刷データ").Cells(n, 4).Value '住所1
      Range("C4").Value = "　　" & Worksheets("印刷データ").Cells(n, 5).Value '住所2
      Range("C5").Value = "　　" & Worksheets("印刷データ").Cells(n, 1).Value & "　ご担当者様" '宛先名
      Range("C6").Value = "　　登録番号:" & Worksheets("印刷データ").Cells(n, 6).Value '登録番号
      Range("E29").Value = Worksheets("印刷データ").Cells(n, 2).Value '〇〇金額
    
    
'印刷

    Range("A1:K52").Select
    Selection.PrintOut Copies:=1, Collate:=True

    Range("C17").Value = "○○○のご案内(控)"
    Selection.PrintOut Copies:=1, Collate:=True
    Range("C17").Value = "○○○のご案内"

    Next n
    
'----------テンプレートへのデータ張り付け&印刷処理終了----------'

    fin = MsgBox("プリンターへの送信完了しました", vbYes, "完了")
    Sheets("印刷画面").Select
      
'画面更新オンに戻しておく

    Application.ScreenUpdating = True

End Sub

プリントアウトできたら、下記のように3つ折にします。

STEP

A4の下を折れ目線に合わせて谷折りします

STEP

折れ目線を目印に山折りして完成

マクロボタンは、開発のフォームで作ることをオススメします。

まとめ

ポイントと注意点をまとめておきます。

ポイント	注意点
窓付き封筒と本マクロを利用することで、業務の効率化が期待できるよ！	データの用意やマクロの微調整はあなたの会社の情シスにお願いしようね！

ポイントと注意点をおさらいしておきます。

インボイス対応ってほんとうに大変・・・。以上です。

＼34インチ湾曲ウルトラワイドモニター没入感ハンパナイ／

本業情シスの私が、厳選しまくって選んだのが湾曲率1000Rの34インチウルトラワイドモニター。
自分だけのプライベート空間で、圧倒的没入感を感じてみたい方には特にオススメします。

この記事を書いた人

らもさんひとり情シス待ったなし

中小企業の小規模（総員2名）情シスに勤務して、まもなく10年目。

取引先の多忙なシステム開発メーカーを見て感じたこと。
『この人たちがうちの情シスに来たら無双できるのに・・・もったいない』

中小企業の小規模情シスのリアルを暴露しつつ、
システム開発メーカー勤務の方が安心して、情シスに転職できるポイントと注意点を全力で発信します。