文字列を指定の幅にカット
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
文字列を指定の幅にカット（漢字分断回避）　　　　　　（081）
　　　　 半角・全角の混在する文字列を同じ半角換算文字長で取り出します。
最後の文字が漢字で、漢字分断がおきたら、半角スペースを付加し、対象文字数が少ない場合は、スペースを補います。StrCutというユーザー関数を作成します。

Option Explicit　　 'SampleNo=081　WindowsXP VB6．0(SP5) 2002．05.17


Private Sub Command1_Click()
　　Label1.Caption = StrCut(Text1.Text, 10)
End Sub


Private Function StrCut(ByRef myString As String, _
　　　　　　　　　　　　　　　　ByVal LenN As Long) As String
　　Dim i　　　　　 As Long
　　Dim j　　　　　 As Long
　　Dim k　　　　　 As Long
　　Dim myStringLen As Long
　　Dim strTemp　　 As String
　　If LenN < 1 Then myString = "": Exit Function
　　myStringLen = LenB(StrConv(myString, vbFromUnicode))
　　If LenN = myStringLen Then　　　　　　 '全部半角文字の場合
　　　　StrCut = myString
　　　　Exit Function
　　ElseIf myStringLen < LenN Then　　　　 '文字数が足りない時
　　　　StrCut = myString & String$(LenN - myStringLen, " ")
　　Else
　　　　strTemp = "": k = 0
　　　　For i = 1 To Len(myString)　　　　 '文字数（半角換算）のカウント
　　　　　　j = Asc(Mid$(myString, i, 1))
　　　　　　If j >= 0 And j <= 255 Then　　'半角の場合のカウント
　　　　　　　　k = k + 1
　　　　　　　　If k > LenN Then Exit For
　　　　　　　　strTemp = strTemp & Mid$(myString, i, 1)
　　　　　　Else
　　　　　　　　k = k + 2　　　　　　　　　'全角の場合のカウント
　　　　　　　　If k <= LenN Then
　　　　　　　　　　strTemp = strTemp & Mid$(myString, i, 1)
　　　　　　　　ElseIf k - 1 = LenN Then　 '漢字分断の処理
　　　　　　　　　　strTemp = strTemp & " "
　　　　　　　　Else
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　StrCut = strTemp
　　End If
End Function


文字幅を合せる場合文字体はプロポーショナル文字は使用しない事
文字サイズは　９・１２・１８ポイントを推薦します。
その他のポイントは少しずれるかもしれません。
下記参照
少し長くなりましたが［半角・全角文字の判定をする］と［文字列の長さを得る］等を参考にし、じっくり見てもらえば理解できるかと思います。

自分が使いやすいのが一番、適当に改造して使って下さい。
但し、大量のデータを何度も処理する場合かなり遅くなります。
その場合は、全角・半角混在文字列だけの使用をお薦めします。
ゆう（U）さん投稿による同様の関数（掲示板より）　　　　　（081）
　　　　 ○私が使用しているStrCutと同じ使用方法の関数です

Private Sub Command2_Click()
　　Label1.Caption = fBackChr(Text1.Text, 10)
End Sub


Private Function fBackChr(ByRef myString As String, _
　　　　　　　　　　　　 ByVal ByteLen As Long) As String
　　Dim i As Long, j As Long, k As Long
　　Dim strReturn As String
　　k = LenB(StrConv(myString, vbFromUnicode))
　　Select Case k
　　　　Case ByteLen
　　　　　　strReturn = myString
　　　　Case Is < ByteLen
　　　　　　strReturn = myString & Space$(ByteLen - k)
　　　　Case Is > ByteLen
　　　　　　k = 0
　　　　　　Do Until (j + k) > ByteLen
　　　　　　　　i = i + 1
　　　　　　　　strReturn = strReturn & Mid$(myString, i, 1)
　　　　　　　　j = LenB(StrConv(strReturn, vbFromUnicode))
　　　　　　　　k = LenB(StrConv(Mid$(myString, i + 1, 1), vbFromUnicode))
　　　　　　Loop
　　　　　　If j < ByteLen Then
　　　　　　　　strReturn = strReturn & Space$(ByteLen - j)
　　　　　　End If
　　End Select
　　fBackChr = strReturn
End Function
私の改良版　　　　　　　(269)
　　 Private Function fStrCut(ByRef CutTxt As String, _
　　　　　　　　　　　　 ByVal CutLen As Long) As String
'半角・全角の混在する文字列を半角換算文字長で取り出し
　　Dim myLen As Long, SysCodeTxt As String
　　SysCodeTxt = StrConv(CutTxt, vbFromUnicode)　　 '文字列を変換
　　myLen = LenB(SysCodeTxt)　　'半角換算のバイト数を取得
　　If myLen <= CutLen Then　　 '指定の長さより短い場合
　　　　fStrCut = CutTxt & Space$(CutLen - myLen)　 '足りない分はスペースで
　　Else　　'該当の文字列の方が長い場合、指定のバイトでカットする
　　　　fStrCut = StrConv(LeftB$(SysCodeTxt, CutLen), vbUnicode)
　　　　If InStr(fStrCut, vbNullChar) > 0 Then
　　　　　　'漢字１バイト目で分断された場合の処理
　　　　　　fStrCut = Left$(fStrCut, InStr(fStrCut, vbNullChar) - 1) & " "
　　　　End If
　　End If
End Function
処理速度を比較して見ました。（半角・全角混在した１５文字を１バイト〜２５バイトまで取出し処理
１万回繰り返した結果です）
　　　　　                                    　Win98SE　　WinXP
　　　　　　Call fStrCut(myStr, 9)　　　　　　　  4.4　　　 1.4 秒       今回の改良版
　　　　　　Call fBackChr(myStr, 9)　　         26.6　　　 9.2 秒　　　 ゆう(U)さん作の分
　　　　　　Call StrCut(myStr, 9)　　　          11.2　　　 4.3 秒　 　　従来の私の分
文字ポイントと文字幅の関係（参考）

　　ＭＳ 明朝　及び　ＭＳ ゴシック

　　　文字ポイント　　半角幅　　　　　全角幅
　　　　　　　９　　　　　　９０　　　　　１８０
　　　　１０　　　　　１０５　　　　　１９５
　　　　１１　　　　　１２０　　　　　２２５
　　　　１２　　　　　１２０　　　　　２４０
　　　　１４　　　　　１５０　　　　　２８５
　　　　１６　　　　　１６５　　　　　３１５
　　 　 １８　　　　　１８０　　　　　３６０
　　　　２０　　　　　２１０　　　　　４０５

　　幅の単位＝twip
　　　1 センチは 567twip、1 インチは 1,440twip になります
　　1 インチは 72 ポイントになります。




2003/04/20