宛名印刷
2017/03/21
エクセルからワードの宛名をレイアウトする。会社の文字調整
管理者用
ワードで宛名のレイアウトを行う。それもエクセルからコントロールする・・・・・・
と始めましたが、前回で予定した宛名項目のレイアウトまでたどりつきました。
それなりに使える様な気がしますが、色々なデータで試して見ると、多くの課題が見られます。
もう少し完成度を上げて、使えるものにしていきたいと、さらに進める事にしました。
今までの続きと言うことですので、前回までのNAVIも参照してください。
今日は、会社名について考えて見ます。
会社名だけの時、今のままでは、”三栄 御中” と言う事で、はがきに対しバランスがとれてません。
全体的に下がるような処理を入れるなど行う必要があるかもしれません。
また、（株）などの略称で住所データを管理している場合があります。
やはり、株式会社に直す必要があります。簡単なスクリプトを最後の所に紹介します。
会社名が短い場合に、文字間にスペースを入れて調整しました。
テキストボックスを移動する処理も検討要ですが、処理が複雑になりそうなのでやめました。
少し長いスクリプトになっていますが、やっている事は単純な事です。
Function kaisya_sm(moji, samaontyu)
moji = LTrim(moji) '両端スペース削除
moji = RTrim(moji)
moji = sp1_1(moji)
moji = kabu(moji)
bak_1 = moji
len_3 = Len(moji)
If len_3 <= 4 Then
If samaontyu = "御中" Then
samaontyu = "御 中"
End If
Select Case len_3
Case 1
nmch_1 = Mid(moji, 1, 1)
If Not samaontyu = "" Then
bak_1 = " " & moji & " " & samaontyu
Else
bak_1 = " " & moji
End If
Case 2
nmch_1 = Mid(moji, 1, 1)
nmch_2 = Mid(moji, 2, 1)
If Not samaontyu = "" Then
bak_1 = " " & nmch_1 & " " & nmch_2 & " " & samaontyu
Else
bak_1 = nmch_1 & " " & nmch_2
End If
Case 3
nmch_1 = Mid(moji, 1, 1)
nmch_2 = Mid(moji, 2, 1)
nmch_3 = Mid(moji, 3, 1)
If Not samaontyu = "" Then
bak_1 = nmch_1 & " " & nmch_2 & " " & nmch_3 & " " & samaontyu
Else
bak_1 = nmch_1 & " " & nmch_2 & " " & nmch_3
End If
Case 4
If Not samaontyu = "" Then
bak_1 = moji & "" & " " & samaontyu
Else
bak_1 = moji
End If
Case Else
End Select
Else
sp = InStr(1, moji, "株式会社", 1)
If sp >= 1 Then
If sp = 1 Then
nm2 = Mid(moji, 5)
nm2_len = Len(nm2)
Select Case nm2_len
Case 1
nmch_1 = Mid(nm2, 1, 1)
If Not samaontyu = "" Then
bak_1 = "株式会社" & " " & nm2 & " " & samaontyu
Else
bak_1 = "株式会社" & " " & nm2
End If
Case 2
nmch_1 = Mid(nm2, 1, 1)
nmch_2 = Mid(nm2, 2, 1)
If Not samaontyu = "" Then
bak_1 = "株式会社" & " " & nmch_1 & " " & nmch_2 & " " & samaontyu
Else
bak_1 = "株式会社" & " " & nmch_1 & " " & nmch_2
End If
Case Else
If Not samaontyu = "" Then
bak_1 = moji & " " & samaontyu
Else
bak_1 = moji
End If
End Select
Else
nm2 = Mid(moji, 1, sp + 1)
nm2_len = Len(nm2)
Select Case nm2_len
Case 1
nmch_1 = Mid(nm2, 1, 1)
If Not samaontyu = "" Then
bak_1 = nm2 & "株式会社" & " " & samaontyu
Else
bak_1 = nm2 & " " & "株式会社"
End If
Case 2
nmch_1 = Mid(nm2, 1, 1)
nmch_2 = Mid(nm2, 2, 1)
If Not samaontyu = "" Then
bak_1 = nmch_1 & " " & nmch_2 & " " & "株式会社" & " " & samaontyu
Else
bak_1 = nmch_1 & " " & nmch_2 & " " & "株式会社"
End If
Case Else
If Not samaontyu = "" Then
bak_1 = moji & "" & " " & samaontyu
Else
bak_1 = moji
End If
End Select
End If
Else
sp = InStr(1, moji, "有限会社", 1)
If sp >= 1 Then
If sp = 1 Then
nm2 = Mid(moji, 5)
nm2_len = Len(nm2)
Select Case nm2_len
Case 1
nmch_1 = Mid(nm2, 1, 1)
If Not samaontyu = "" Then
bak_1 = "有限会社" & " " & nm2 & " " & samaontyu
Else
bak_1 = "有限会社" & " " & nm2
End If
Case 2
nmch_1 = Mid(nm2, 1, 1)
nmch_2 = Mid(nm2, 2, 1)
If Not samaontyu = "" Then
bak_1 = "有限会社" & " " & nmch_1 & " " & nmch_2 & " " & samaontyu
Else
bak_1 = "有限会社" & " " & nmch_1 & " " & nmch_2
End If
Case Else
If Not samaontyu = "" Then
bak_1 = moji & " " & samaontyu
Else
bak_1 = moji
End If
End Select
Else
nm2 = Mid(moji, 1, sp + 1)
nm2_len = Len(nm2)
Select Case nm2_len
Case 1
nmch_1 = Mid(nm2, 1, 1)
If Not samaontyu = "" Then
bak_1 = nm2 & "有限会社" & " " & samaontyu
Else
bak_1 = nm2 & " " & "有限会社"
End If
Case 2
nmch_1 = Mid(nm2, 1, 1)
nmch_2 = Mid(nm2, 2, 1)
If Not samaontyu = "" Then
bak_1 = nmch_1 & " " & nmch_2 & " " & "有限会社" & " " & samaontyu
Else
bak_1 = nmch_1 & " " & nmch_2 & " " & "有限会社"
End If
Case Else
If Not samaontyu = "" Then
bak_1 = moji & "" & " " & samaontyu
Else
bak_1 = moji
End If
End Select
End If
Else
If Not samaontyu = "" Then
bak_1 = moji & "" & " " & samaontyu
Else
bak_1 = moji
End If
End If
End If
End If
kaisya_sm = bak_1
End Function
（株）、(有)を株式会社」、有限会社に変えるスクリプトです。
Function kabu(moji)
moji = Replace(moji, "㈱", "株式会社 ")
moji = Replace(moji, "（株）", "株式会社 ")
moji = Replace(moji, "(株)", "株式会社 ")
moji = Replace(moji, "（有）", "有限会社 ")
moji = Replace(moji, "(有)", "有限会社 ")
moji = Replace(moji, "㈲", "有限会社 ")
moji = Replace(moji, " ", " ")
kabu = moji
End Function
