シートのVBAコード
下記のコードを追加してください
'データのセット
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
実行結果
宛先の郵便番号に最初の住所録の郵便番号がセットされている