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

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

対象バージョン : 97
最終更新日 : 1998/08/25 （オリジナル作成日：1997/04/27）

概　要　

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

tch_025_1.gif (2062 バイト)

解　説

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

構　文

Call KintoWariH(Obj, Value, x, y, width [,FontName] [,FontSize])

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

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

Sub プロシージャ

Public Sub KintoWariH(argrpt As Report, argValue As Variant, _
    argX As Single, argY As Single, ArgWidth As Single, _
    Optional ArgFontName As Variant, Optional ArgFontSize As Variant)

Dim sngX As Single
Dim sngY As Single
Dim sngValueWidth As Single
Dim sngWidthLimit As Single
Dim sngChrWidth 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
sngWidthLimit = ArgWidth * 567

sngValueWidth = argrpt.TextWidth(argValue)

' 印字指示幅より印刷文字列の方が長い場合、印字可能文字まで印刷
If sngValueWidth > sngWidthLimit Then
    For intChrPos = 1 To Len(argValue)
        stChr = Mid(argValue, intChrPos, 1)
        sngChrWidth = argrpt.TextWidth(stChr)
        If sngPrinted + sngChrWidth > sngWidthLimit Then Exit For
        argrpt.CurrentX = sngX
        argrpt.CurrentY = sngY
        argrpt.Print stChr
        sngX = sngX + sngChrWidth
        sngPrinted = sngPrinted + sngChrWidth
    Next
    Exit Sub
End If

' 文字間隔計算
If Len(argValue) > 1 Then
    sngGap = (sngWidthLimit - sngValueWidth) / (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
    sngX = sngX + argrpt.TextWidth(stChr) + sngGap
Next
End Sub

使用例

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

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

補　足

Access 2000 では、"TextAlign/文字配置" プロパティに "均等割り付け" が追加されました。

改訂履歴

1998/02/27 縦書き用プロシージャ掲載のため、サンプル表示追加、及びプロシージャ名等変更。

1999/08/25 Access 2000 についての補足を追加

目次へ戻る