Excelだけで年賀状印刷する

#「Excelだけで差し込み印刷」から「年賀状印刷」へ発展させる。
年賀状プレビュー
<img width=500 alt=年賀2020060701.png src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/f75206c0-8408-b917-1aa2-c267eef6b993.png>

##差出人の選択は、プルダウンのリストに空白を表示しない
宛先　[住所録のサンプル](https://www.microsoft.com/ja-jp/office/pipc/nengajo/05.aspx)はMSから頂戴しました。
![年賀20200607901_宛先.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/e027435b-08d0-3653-634e-55e5d349c86a.png)
差出人
![年賀20200607901_差出人.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/dadcf840-3101-75a9-a91c-47379aa899e5.png)

##プルダウンリストに空白を表示しない
![年賀20200607903_差出人プルダウン.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/59515ee7-d31a-5130-9b6e-629f1a0ca12a.png)
入力規則設定で空白を除く設定をする
<pre>
=OFFSET(差出人!$A$3,,,COUNTA(差出人!$A:$A))
</pre>
<img width=500 alt=年賀20200607904_差出人プルダウン入力規則.png src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/32057d40-7dbb-9e88-2873-2964aecf99eb.png>

##漢字をカタカナにする
キラキラＮＡＭＥはむりなようです。
<pre>
=PHONETIC([@姓])&"  "&PHONETIC([@名])
</pre>

##郵便番号から住所変換　その１ Web版(Excel標準機能 QueryTables.Add)　
上は、Excelマクロで取得した結果、下はWebサイトの取得結果を手作業で貼り付けた
Web検索結果の表部分を取得して、セルに貼り付ける事ができる。
![年賀2020060905_Web郵便番号→住所変換作業シート.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/a8b9879d-28a5-f2b4-9253-eb781244dfc0.png)
マクロ記録で　「データ　→　外部データの取り込み　→　Webクエリ」で例のマクロと同じ様なものが出力されるが、対象は表のみのようだ。　

```vba:郵便番号から住所変換に日本郵便サイトを使う
    With ActiveSheet.QueryTables.Add(Connection:= _
              "URL;http://www.post.japanpost.jp/cgi-zip/zipcode.php?zip=671-1234" & , _
                Destination:=Range("A4"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlOverwriteCells      '　前のセルデータを上書きする。
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        .WebSelectionType = xlAllTables         'TABLEを取得
        .Refresh                                'Activeでないと表示更新されない
    
        ' Destination:=Range("A4")に結果が保存される
        ' 保存された結果から住所を取り出すとかの処理はここに書く 

        .Delete                                 '名前の定義が残ってしまうのでここで削除
    End With
```

##郵便番号から住所変換　その２ csvファイル版　
[郵便番号データ](https://www.post.japanpost.jp/zipcode/download.html)は日本郵便サイトからダウンロードする。
全国版(11.7MB)CSVを検索に使う。

###Schema.iniを使ってみる。
[Schema.ini](https://docs.microsoft.com/en-us/sql/odbc/microsoft/schema-ini-file-text-file-driver?view=sql-server-ver15)の解説こちら
これがあると、Headerの無いCSVも列名を使って処理できるし、csvファイルと同じディレクトに置いておけば、勝手に使ってくれる。
更新作業も郵便番号CSVをDownLoadして解凍するだけ。
複数のＰＣから使いたい場合は、共有ディレクトに置けば良い。

```;Schema.ini
[KEN_ALL.CSV]
ColNameHeader=True
CharacterSet=ANSI
Format=Delimited(,)
Col1=CODE1      Char Width 007
Col2=ZIP_OLD    Char Width 005
Col3=ZIPCODE    Char Width 007
Col4=KEN_KANA   Char Width 050
Col5=SHI_KANA   Char Width 050
Col6=CHO_KANA   Char Width 100
Col7=KEN_KANJI  Char Width 050
Col8=SHI_KANJI  Char Width 050
Col9=CHO_KANJI  Char Width 100
Col10=FLG1      Char Width 001
Col11=FLG2      Char Width 001
Col12=FLG3      Char Width 001
Col13=FLG4      Char Width 001
Col14=FLG5      Char Width 001
Col14=FLG6      Char Width 001
```
![年賀2020060906_CSV郵便番号→住所変換.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/aa278378-7b2f-e5ec-f4bc-53e03a865325.png)
この実行にDebug.Printをいれたイミディエイト
ＣＳＶファイルをＳＱＬで検索している。
![年賀2020060907_CSV郵便番号→住所変換.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/c348ebe5-8255-c2bc-ad9f-972647fed7ca.png)

##郵便番号から住所変換　その３ Web版（MSXML2.XMLHTTP.3.0）　
郵便番号で日本郵便サイトを検索し、応答の中から文字列処理をして住所を返す

```vba:郵便番号から住所変換に日本郵便サイトを使う
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
    oXMLHTTP.Open "GET", "https://www.post.japanpost.jp/cgi-zip/zipcode.php?zip=" & postAddress, False
    oXMLHTTP.Send

    If oXMLHTTP.Status = 200 Then
        resData = oXMLHTTP.responseText
        ’ここで受信情報から住所を探す
        End If
    End If
End Function
```
![年賀2020060909_Web郵便番号→住所変換Web2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/e7975e31-07e5-ac2a-36c6-82135ccbbcd8.png)
HTMLが返ってくるので、必要な文字を探す
欲しいとこだけピックアップすると
![年賀2020060910_Web郵便番号→住所変換Web2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/6feb1ef4-c451-7220-d1bb-fe40c487145f.png)
これを探して、住所にする

##テキストボックスにセルデータを転記する
住所、宛名、差出人の配置は、テキストボックスで行う。
綺麗に配置するため、複数のテキストボックスを配置した。
![年賀2020060708_はがき表書きに大量のテキストボックス.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/f8aa1aae-7cc8-ce9f-4e99-a049399bf219.png)

テキストボックスへ転記するデータは、宛先、差出人設定から、配置しやすいように、ここで編集している。
![年賀2020060707_はがき表書き転送データ編集.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/a306202a-bb4d-4c1d-61fd-613b2557a48a.png)

住所縦書き対応のため、算用数字を漢数字に置き換える
###ワークシート関数をマクロで使う
ワークシートでは、これで　1 →　一　変換できる。しかし、式が長くてメンテしにくい

```vba:SUBSTITUTE(ワークシート)
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(ASC(P3),1,"一"),2,"二"),3,"三"),4,"四"),5,"五"),6,"六"),7,"七"),8,"八"),9,"九"),0,"〇")
```

マクロでワークシート関数を使うには、Application.WorksheetFunction

```vba:SUBSTITUTE(マクロ)
'-------------------------------------
' 住所縦書きのため
' worksheet関数をマクロで使う
' 1234567890 → 一二三四五六七八九〇
'-------------------------------------
Private Function num2kanji(ByVal fromStr As String)
    With Application.WorksheetFunction
        fromStr = .Asc(fromStr)
        fromStr = .Substitute(fromStr, "1", "一")
        fromStr = .Substitute(fromStr, "2", "二")
        fromStr = .Substitute(fromStr, "3", "三")
        fromStr = .Substitute(fromStr, "4", "四")
        fromStr = .Substitute(fromStr, "5", "五")
        fromStr = .Substitute(fromStr, "6", "六")
        fromStr = .Substitute(fromStr, "7", "七")
        fromStr = .Substitute(fromStr, "8", "八")
        fromStr = .Substitute(fromStr, "9", "九")
        num2kanji = .Substitute(fromStr, "0", "〇")
    End With
End Function
```

##印刷イメージ画面
<img width=500 alt=年賀2020060701.png src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/f75206c0-8408-b917-1aa2-c267eef6b993.png>

##ボタン
###戻る、進む
<img width=200 alt=年賀2020060702_プレビュー戻る進む.png src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/ad366546-8fe5-8791-bfd4-2ee4cb31a972.png>
見たままの機能。とあるページで、Findより配列処理がかなり高速であると見たので、配列処理で検索してみた。

```vba:Findを使わない
    Dim myRange As Range
    Dim myAry As Variant
    Dim ix As Long
    
    With ThisWorkbook.Sheets(addrssSheet)
        '-----------------------------
        'findを使わない(配列処理の方が速いらしい）
        '-----------------------------
        Set myRange = .Range(.Cells(1, 3), .Cells(Rows.Count, 1).End(xlUp))
        myAry = myRange　' Range を Variant に入れると配列操作できる
        For ix = LBound(myAry) To UBound(myAry)
            If 処理対象行判定 Then
                'ここに処理を書く
　　　　　　　　　'現在の行は、どこかのセルに保存しておく
            End If
        Next
    End With
```

これが都合よく、現在の行がわかるので、行の上下動作でこのボタンのマクロが書けた

```vba:マクロ呼び出しに引数を使う
'-------------------------------------
'プレビュー 前後
'-------------------------------------
Public Sub preview(Optional previews As Long = 1)
    Dim myRange As Range
    Dim myAry As Variant
    Dim ix As Long
    Dim forfrom As Long
    Dim forto As Long
    Dim forstep As Long
    
    With ThisWorkbook.Sheets(addrssSheet)
        '-----------------------------
        '前後宛先
        '-----------------------------
        Set myRange = .Range(.Cells(1, 3), .Cells(Rows.Count, 1).End(xlUp))
        myAry = myRange
    
        If previews = 1 Then
            forto = UBound(myAry)   '順方向
        Else
            forto = 1               '逆順方向
        End If
        
        For ix = 現在の行 + previews To forto Step previews
            If 処理対象行判定 Then
                'ここに処理を書く
　　　　　　　　　'現在の行は、どこかのセルに保存しておく
            End If
        Next
    End With
End Sub
```

### ボタンに引数付きでマクロを登録する
'マクロ名　引数'の形式でマクロを登録する
<img width=400 alt=年賀2020060908_ボタンマクロ引数付き.png src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/69b8f55d-6072-b53e-8f7f-d52a4495fbab.png>

###印刷
現在表示内容を印刷する（説明はありません）
黄色のボタン

###全印刷
印刷対象をすべて印刷する（説明はありません）
ピンクのボタン

###ＳＴＯＰ
トグルスイッチ的な表示　灰色　←→　赤　の変更をしている。
<img width=200 alt=年賀2020060704_印刷とプレビューを止める.png src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/a1adb791-7d35-9f61-46a9-ca6c1124cc18.png>

###画面プレビュー
回転スイッチ的な表示　画面プレビュ → プリンタプレビュ　→　印刷　→　画面プレビュ　の変更をしている。
<img width=300 alt=年賀2020060705_画面プレビューボタン.png src=https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/646883/570a8f8c-77bb-7227-7b80-4c84457e86e6.png>
画像切り替えではなく、プロパティを操作する

```vba:Shapesプロパティ操作
        Select Case .Range(modePrint) '0:画面プレビュ → 1:プリンタプレビュ　→　2:印刷　→　0:画面プレビュ　の　ループ
            Case 0
                .Range(modePrint).Value = 1
                .Shapes.Range(Array(buttonName)).TextFrame2.TextRange.Characters.Text = "プリンタ" & vbCrLf & "プレビュー"
                .Shapes.Range(Array(buttonName)).Fill.ForeColor.RGB = RGB(0, 176, 240)
                .Shapes.Range(Array(buttonName)).Shadow.ForeColor.RGB = RGB(255, 255, 0)
            Case 1
                .Range(modePrint).Value = 2
                .Shapes.Range(Array(buttonName)).TextFrame2.TextRange.Characters.Text = "印刷"
                .Shapes.Range(Array(buttonName)).Fill.ForeColor.RGB = RGB(148, 87, 164)
                .Shapes.Range(Array(buttonName)).Shadow.ForeColor.RGB = RGB(255, 255, 0)
            Case 2
                .Range(modePrint).Value = 0
                .Shapes.Range(Array(buttonName)).TextFrame2.TextRange.Characters.Text = "画面" & vbCrLf & "プレビュー"
                .Shapes.Range(Array(buttonName)).Fill.ForeColor.RGB = RGB(0, 176, 80)
                .Shapes.Range(Array(buttonName)).Shadow.ForeColor.RGB = RGB(255, 255, 0)
        End Select
```

[物忘れ防止 Excelだけで年賀状印刷住所録付きxx.xlsm ](https://github.com/sugita0301/douzo)