超シンプルなはがき印刷ソフトを作ってみよう　Step 5　宛先の郵便番号をセットする

超シンプルなはがき印刷ソフトを作ってみよう

Step 5　宛先の郵便番号をセットする

シートコード

下記のコードを追加してください

'データのセット
Private Sub ExPrintDataSet(drow As Long)
    Dim i As Integer
    Dim n As Integer
    Dim dat As String
    Dim s As String

    '宛先郵便番号
    n = 1
    dat = ActiveSheet.Cells(drow, 3)
    For i = 1 To 8
        s = Mid(dat, i, 1)
        If s <> "-" And s <> "－" Then
            Sheets("はがき表").Shapes("〒" & n).TextFrame.Characters.Text = s
            n = n + 1
        End If
    Next
End Sub

'印刷の開始
Private Sub ExPrintStart()
    Dim lrow As Long
    Dim j  As Long

    lrow = ExLastRow
    For j = 10 To lrow
        If ActiveSheet.Cells(j, 2) <> "" Then
            ExPrintDataSet j
        End If
    Next

End Sub

下記のコードに変更してください

'印刷の開始処理と終了処理
Private Sub ExPrintReady(sw As Boolean)
    Dim t As Object
    Dim s As String
    Dim i As Integer

    For Each t In Sheets("はがき表").Rectangles
        'シェイプの名前
        s = t.Name

        '不必要なシェイプを消す/戻す
        If Left(s, 3) = "ガイド" Then
            '表示
            t.Visible = Not sw
        Else    '枠線を消す/戻す
            t.ShapeRange.Line.Visible = Not sw
        End If
    Next

    If sw = False Then
        Sheets("はがき表").Shapes("宛先住所").TextFrame.Characters.Text = "宛先住所"
        Sheets("はがき表").Shapes("宛先名前").TextFrame.Characters.Text = "名前"
        Sheets("はがき表").Shapes("住所").TextFrame.Characters.Text = "住所"
        Sheets("はがき表").Shapes("名前").TextFrame.Characters.Text = "名前"
        For i = 1 To 7
            Sheets("はがき表").Shapes("〒" & i).TextFrame.Characters.Text = i
            Sheets("はがき表").Shapes("下〒" & i).TextFrame.Characters.Text = 10 - i
        Next
    End If
End Sub

Private Sub ExPrint(mode As Integer)
    Dim lrow As Long

    lrow = ExLastRow
    If lrow = 9 Then
        Beep
        MsgBox "宛先を入力してください。"
        Exit Sub
    End If

    If Range("C6") = 0 Then
        Beep
        MsgBox "印刷する宛先の印刷マークに1を入力してください。"
        Exit Sub
    End If

    '印刷の開始処理
    ExPrintReady True

    '印刷の開始
    ExPrintStart

    '印刷の終了処理
    ExPrintReady False
End Sub

実行結果

	宛先の郵便番号に最初の住所録の郵便番号がセットされている

Topへ