VBAの入力規則について質問です。 - MSN相談箱

>ファイルの軽量化のため、VBAで設定したいと思っています。
そういう趣旨なら、全部、マクロにしてしまえばいかがですか？

なお、CheckByte関数はおまけです。ESCを押した時に、バイト数で文字を切るプログラムです。Mid 関数では、Byte では切ることは出来ません。しかし、100Byte でもなると、長くなり、Application.Undo　のほうが楽です。
CheckByteは、また、Option 引数を付けなければ、バイト数をカウントすることになります。

'//
Const mLIMIT As Long = 10　　'文字制限数
Private Sub Worksheet_Change(ByVal Target As Range)
　Dim msgRtn As VbMsgBoxResult
　If Target.Column <> 4 Then Exit Sub 'D列
　If Target.Cells.Count > 1 Then Exit Sub
　If Target.Value = "" Then Exit Sub
　Application.EnableEvents = False
　If LenB(StrConv(Target.Value, vbFromUnicode)) > mLIMIT Then
　　msgRtn = MsgBox("全角50文字（半角100文字）以内で入力してください。", 16 + vbRetryCancel, "入力エラー")
　　If msgRtn = vbIgnore Then
　　　Application.SendKeys "[F2]"
　　　Application.EnableEvents = True
　　　Exit Sub
　　ElseIf msgRtn = vbCancel Then
　　　Application.Undo
　　　'Target.Value = CheckByte(Target.Value, mLIMIT) 'ESCで、文字を制限まで切る
　　　On Error GoTo 0
　　End If
　End If
　Application.EnableEvents = True
End Sub

Function CheckByte(ByVal strTxt As String, Optional ilimit As Long)
　'バイトで文字列を切る
　Dim i As Long
　Dim a()　As Byte
　Dim b(1) As Byte
　Dim cnt As Long
　Dim buf As String
　a = strTxt
　For i = 0 To UBound(a) Step 2
　　If CLng(a(i + 1)) < 10 Then
　　　cnt = cnt + 1
　　Else
　　　cnt = cnt + 2
　　End If
　　b(0) = a(i): b(1) = a(i + 1)
　　buf = buf & CStr(b())
　　If cnt >= ilimit Then
　　　Exit For
　　End If
　Next
　If ilimit > 0 Then
　　CheckByte = buf
　Else
　　CheckByte = cnt
　End If
End Function

投稿日時 - 2010-10-25 21:29:56