レポート：均等割付による印刷（縦書き）

対象バージョン : 97, 2000, 2002, 2003
最終更新日 : 2005/04/25 （オリジナル作成日：1998/02/27）

概　要　

　レポートで縦書きで均等割付による印字を行う方法です。

tch_030_1.gif (2237 バイト)

解　説

　プロパティ等の設定では実現ができないので、Report オブジェクトの Print メソッドを利用した汎用 Sub プロシージャです。

構　文

Call KintoWariV(Obj, Value, x, y, Height [,FontName] [,FontSize])

引　数	内　　　　　容
obj	表示する Report オブジェクトを指定します。
Value	表示する文字列式を指定します。
x	表示する "Left/左位置" を示す数式を指定します。単位は cm で、小数の使用が可能です。
y	表示する "Top/上位置" を示す数式を指定します。単位は cm で、小数の使用が可能です。
Height	表示する幅を "Height/高さ" を示す数式を指定します。単位は cm で、小数の使用が可能です。
FontName	フォント名を示す文字列式を指定します。
FontSize	フォントサイズを示す数式を指定します。

FontName と FontSize は省略可能です。それぞれを省略した場合、Print メソッドでの省略時値が使用されます。
FontName を省略し、FontSize を指定する場合は、カンマが必要です。

Sub プロシージャ

Public Sub KintoWariV(argrpt As Report, argValue As Variant, _
    argX As Single, argY As Single, ArgHeight As Single, _
    Optional ArgFontName As Variant, Optional ArgFontSize As Variant)
Dim sngX As Single
Dim sngY As Single
Dim sngValueHeight As Single
Dim sngHeightLimit As Single
Dim sngChrHeight As Single
Dim sngPrinted As Single
Dim intChrPos As Integer
Dim stChr As String
Dim sngGap As Single

If IsNull(argValue) Or argValue = "" Then Exit Sub
If Not IsMissing(ArgFontName) Then
    argrpt.FontName = ArgFontName
End If
If Not IsMissing(ArgFontSize) Then
    argrpt.FontSize = ArgFontSize
End If
' Twip へ変換
sngX = argX * 567
sngY = argY * 567
sngHeightLimit = ArgHeight * 567
sngValueHeight = argrpt.TextHeight(argValue) * Len(argValue)
' 印字指示高より印刷文字列の方が長い場合、印字可能文字まで印刷
If sngValueHeight > sngHeightLimit Then
    For intChrPos = 1 To Len(argValue)
        stChr = Mid(argValue, intChrPos, 1)
        sngChrHeight = argrpt.TextHeight(stChr)
        If sngPrinted + sngChrHeight > sngHeightLimit Then Exit For
        argrpt.CurrentX = sngX
        argrpt.CurrentY = sngY
        argrpt.Print stChr;
        sngY = sngY + sngChrHeight
        sngPrinted = sngPrinted + sngChrHeight
        Next
    Exit Sub
End If
' 文字間隔計算
If Len(argValue) > 1 Then
    sngGap = (sngHeightLimit - sngValueHeight) / (Len(argValue) - 1)
End If
For intChrPos = 1 To Len(argValue)
    stChr = Mid(argValue, intChrPos, 1)
    argrpt.CurrentX = sngX
    argrpt.CurrentY = sngY
    argrpt.Print stChr
    sngY = sngY + argrpt.TextHeight(stChr) + sngGap
Next

End Sub

使用例

　レポートの詳細セクションの "OnFormat/フォーマット時" のイベントプロシージャで、次のように設定します。

Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
Call KintoWariV(Me, Me![名前], 1.5, 0.5, 3 ,"明朝",9 )
End Sub

補　足

2000 では SR-1 が適用されている必要があります。2000 SR-1 は、環境によって TextWidth メソッドが正しく動作しないことがあるようです（原因不明）。

改訂履歴

2001/06/19 2000 の補足追加。

目次へ戻る