VB6による宛名封筒印刷の縦書き仕様を横書きにするには？ (ID:101532)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

封筒印刷の全コードを記します。
Option Explicit
    Dim AdoRs9 As ADODB.Recordset
'***************************************************************************
' 印刷処理
' 戻り値 =0:該当データ無し  =-1:プログラム・エラー  >1:正常終了
'***************************************************************************
Public Function RPT封筒小_Print(P_PRINT As ZC010_Print) As Long
'
    Dim ADRS_FNT As Long, NAME_FNT As Long, I As Long
    Dim HH As Single, BAR As String
    Dim YUBIN As String
    
    On Error Resume Next
    
    RPT封筒小_Print = -1
    
'   印刷編集を初期化
'   P_PRINT.E_StartEdit 0 : MonoCro Print
'   P_PRINT.E_StartEdit 1 : Color Print
'
    P_PRINT.E_StartEdit 0, 1, 1, 9999
    P_PRINT.E_Pitch 15, 5
    ' 自社データを検索
    Set AdoRs9 = New ADODB.Recordset
    AdoRs9.Open "ユーザー", Cn, adOpenStatic, adLockOptimistic
    ' 明細データを検索
    SQL_TXT = "SELECT DISTINCTROW [顧客-基本].顧客コード, [顧客-基本].郵便番号, [顧客-基本].住所1, " & _
              "[顧客-基本].住所2, [顧客-基本].氏名, [顧客-基本].敬称 " & _
              "From [顧客-基本] " & _
              "Where ([顧客-基本].氏名 = '" & 封筒印刷.顧客.Text & "') WITH OWNERACCESS OPTION;"
    Set AdoRs = New ADODB.Recordset
    AdoRs.Open SQL_TXT, Cn, adOpenStatic, adLockOptimistic
'   該当データが０件の時、処理終了
    If AdoRs.RecordCount > 0 Then
       If (Len(AdoRs![住所1]) < 17) Then
          ADRS_FNT = 18
       End If
       If (Len(AdoRs![住所1]) = 17) Then
          ADRS_FNT = 17
       End If
       If (Len(AdoRs![住所1]) = 18) Then
          ADRS_FNT = 16
       End If
       If (Len(AdoRs![住所1]) = 19) Then
          ADRS_FNT = 15
       End If
       If (Len(AdoRs![住所1]) = 20) Then
          ADRS_FNT = 14
       End If
       If AdoRs![敬称] <> "御中" Then
          If (Len(AdoRs![氏名]) < 6) Then
             NAME_FNT = 34
          End If
          If (Len(AdoRs![氏名]) = 6) Then
             NAME_FNT = 32
          End If
          If (Len(AdoRs![氏名]) = 7) Then
             NAME_FNT = 30
          End If
          If (Len(AdoRs![氏名]) = 8) Then
             NAME_FNT = 28
          End If
          If (Len(AdoRs![氏名]) = 9) Then
             NAME_FNT = 26
          End If
          If (Len(AdoRs![氏名]) = 10) Then
             NAME_FNT = 24
          End If
          If (Len(AdoRs![氏名]) > 10) Then
             NAME_FNT = 20
          End If
       Else
          If (Len(AdoRs![氏名]) <= 7) Then
             NAME_FNT = 28
          End If
          If (Len(AdoRs![氏名]) = 8) Then
             NAME_FNT = 26
          End If
          If (Len(AdoRs![氏名]) = 9) Then
             NAME_FNT = 24
          End If
          If (Len(AdoRs![氏名]) = 10) Then
             NAME_FNT = 22
          End If
          If (Len(AdoRs![氏名]) = 11) Then
             NAME_FNT = 20
          End If
          If (Len(AdoRs![氏名]) = 12) Then
             NAME_FNT = 18
          End If
          If (Len(AdoRs![氏名]) > 13) Then
             NAME_FNT = 15
          End If
       End If
       '郵便番号の印字
       P_PRINT.E_Font "ＭＳ ゴシック", 16, True, 0
       YUBIN = ""
       For I = 1 To 8
           If Mid$(AdoRs![郵便番号], I, 1) <> "-" Then
              YUBIN = YUBIN & Mid$(AdoRs![郵便番号], I, 1)
           End If
       Next
       For I = 1 To 7
           P_PRINT.E_String 21 + (I - 1) * 7, 1, Mid$(YUBIN, I, 1), RGB(0, 0, 0)
       Next
       '住所1の印字
       P_PRINT.E_Font "FC行楷書体", ADRS_FNT, True, 0
       HH = ADRS_FNT / 2.835 + 1
       If Not IsNull(AdoRs![住所1]) Then
          For I = 1 To Len(AdoRs![住所1])
             BAR = Mid$(AdoRs![住所1], I, 1)
'             If BAR = "−" Then BAR = "ー"
'             P_PRINT.E_String_Tate 60, 14 + (I - 1) * HH, BAR, RGB(0, 0, 0)  '縦書き
             If BAR = "ー" Or BAR = "−" Then BAR = "｜"
             P_PRINT.E_String 60, 14 + (I - 1) * HH, BAR, RGB(0, 0, 0)
          Next
       End If
       '住所2の印字
       P_PRINT.E_Font "FC行楷書体", ADRS_FNT, True, 0
       If Not IsNull(AdoRs![住所2]) Then
          For I = 1 To Len(AdoRs![住所2])
             BAR = Mid$(AdoRs![住所2], I, 1)
'             If BAR = "−" Then BAR = "ー"
'             P_PRINT.E_String_Tate 48, 28 + (I - 1) * HH, BAR, RGB(0, 0, 0)  '縦書き
             If BAR = "ー" Or BAR = "−" Then BAR = "｜"
             P_PRINT.E_String 48, 28 + (I - 1) * HH, BAR, RGB(0, 0, 0)
          Next
       End If
       '氏名の印字
       P_PRINT.E_Font "FC行楷書体", NAME_FNT, True, 0
       HH = NAME_FNT / 2.835 + 1
       If Not IsNull(AdoRs![氏名]) Then
          For I = 1 To Len(AdoRs![氏名] & "  " & AdoRs![敬称])
             BAR = Mid$(AdoRs![氏名] & AdoRs![敬称], I, 1)
'             If BAR = "−" Then BAR = "ー"
'             P_PRINT.E_String_Tate 20, 20 + (I - 1) * HH, BAR, RGB(0, 0, 0)  '縦書き
             If BAR = "ー" Or BAR = "−" Then BAR = "｜"
             P_PRINT.E_String 20, 20 + (I - 1) * HH, BAR, RGB(0, 0, 0)
           Next
       End If
       '横線をひく
       If PrintS = 2 Then
          P_PRINT.E_DrawStyle vbSolid, 4 ' 10
          P_PRINT.E_Line 0, 140, 65, 140, RGB(0, 0, 0)
          P_PRINT.E_Line 0, 168, 65, 168, RGB(0, 0, 0)
          P_PRINT.E_DrawStyle vbSolid, 1
          P_PRINT.E_Line 5, 142, 60, 142, RGB(0, 0, 0)
          P_PRINT.E_Line 5, 166, 60, 166, RGB(0, 0, 0)
          P_PRINT.E_Font "ＭＳ Ｐ明朝", 10, False, 0
          P_PRINT.E_String 4.8, 144, "〒 " & AdoRs9![〒], RGB(0, 0, 0)
          P_PRINT.E_String 4.8, 148, AdoRs9![住所], RGB(0, 0, 0)
          P_PRINT.E_String 4.8, 160, "℡ " & AdoRs9![電話番号], RGB(0, 0, 0)
          P_PRINT.E_Font "ＭＳ Ｐゴシック", 14, True, 0
          P_PRINT.E_String 4.8, 153, AdoRs9![会社名], RGB(0, 0, 0)
       End If
       AdoRs.MoveNext
    End If
'   レコードセットを閉じる
    AdoRs.Close
    AdoRs9.Close
    
    ' 終了処理
    If P_PRINT.P_CheckData = False Then    ' 該当する印刷データ無し ?
        RPT封筒小_Print = 0
    Else
        RPT封筒小_Print = 1
    End If
    P_PRINT.E_EndEdit
    
End Function

一体何から手をつければよいのか苦しんでいます。
散々検索しましたが、知りたい事を教えてくれるものが見つかりませんでした。
どなたかよろしくお願いします。

←解決時は質問者本人がここをチェックしてください。

戻る