Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3861 / 13646 ツリー ←次へ | 前へ→

【59758】エクセルのマクロで文字判定 初心者β 09/1/7(水) 12:48 質問[未読]
【59760】Re:エクセルのマクロで文字判定 Yuki 09/1/7(水) 13:11 発言[未読]
【59767】Re:エクセルのマクロで文字判定 初心者β 09/1/7(水) 17:27 発言[未読]
【59777】Re:エクセルのマクロで文字判定 Yuki 09/1/8(木) 8:08 発言[未読]
【59792】Re:エクセルのマクロで文字判定 初心者β 09/1/8(木) 19:57 発言[未読]
【59793】Re:エクセルのマクロで文字判定 Abyss 09/1/8(木) 20:16 回答[未読]
【59809】Re:エクセルのマクロで文字判定 初心者β 09/1/9(金) 15:36 お礼[未読]

【59758】エクセルのマクロで文字判定
質問  初心者β  - 09/1/7(水) 12:48 -

引用なし
パスワード
   はじめまして。
ただいま、仕事で利用するエクセルシートの
入力サポート画面をVBAで作っています。

とは言っても簡単な物で、入力すべく項目を用意してあげて
全項目が埋まってればエクセルにそのデータを貼り付け完了といったモノです。

そこで少し困る問題が起きました。
文字数制限と文字(状態)制限をかけたいのです。

1:全角30文字を超える入力に対してアラートで知らせたい
2:英数、カタカナ文字は半角で入力しなくてはならない

半角文字を入力する都合上、全角30文字という制限も微妙に矛盾してますがお許し下さい。
(半角60文字と考えればいいのでしょうか?)

文字数の判定はヘルプでなんとなくわかりそうですが途中で道に迷いました。
2の半角にしなくてはいけないルールですが、全角入力を半角に自動で置き換える
都合の良い方法があれば嬉しいです。
最悪は全角でっせ!と教えてくれるのでもいいです。

ただ、英数文字とカタカナ文字を半角にしなくてはいけないルールなので
その辺の判定方法が全く分かりません。
できればコードをお願いしたいのですがご対応いただけるでしょうか。

ちなみに、環境は
Windows 2000 と XP マシンです。
エクセルのバージョンは2002です。

よろしくお願いします

【59760】Re:エクセルのマクロで文字判定
発言  Yuki  - 09/1/7(水) 13:11 -

引用なし
パスワード
   ▼初心者β さん:
こんにちは。

>ただいま、仕事で利用するエクセルシートの
>入力サポート画面をVBAで作っています。
>

これってUserFormのTextBoxへの入力ですか
それともセルへの入力なのですか。

【59767】Re:エクセルのマクロで文字判定
発言  初心者β  - 09/1/7(水) 17:27 -

引用なし
パスワード
   ▼Yuki さん:
>▼初心者β さん:
>こんにちは。
>
>>ただいま、仕事で利用するエクセルシートの
>>入力サポート画面をVBAで作っています。
>>
>
>これってUserFormのTextBoxへの入力ですか
>それともセルへの入力なのですか。

お返事ありがとうございます。
肝心な項目が抜けており申し訳ございません。
入力窓はUserFormのTextBoxを利用しております。
なので入力完了後に登録ボタンを押したときに
文字列数と半角判断を行って下さればOKです。
(入力途中ではたぶん私の技術では難しいと思ってます)

よろしくお願いします

【59777】Re:エクセルのマクロで文字判定
発言  Yuki  - 09/1/8(木) 8:08 -

引用なし
パスワード
   ▼初心者β さん:

>入力窓はUserFormのTextBoxを利用しております。
>なので入力完了後に登録ボタンを押したときに
>文字列数と半角判断を行って下さればOKです。

ということなので
又はTextBox1_Exitイベントでチェックしても良いですね。

Private Sub CommandButton1_Click()
  Dim strIn  As String
  Dim strLen As Long
  Dim lngRst As Long
  Dim strMsg As String
  
  strIn = Me.TextBox1.Value
  If strIn = "" Then Exit Sub
  If strInputCheck(strIn, strLen) <> 0 Then
    strMsg = "全角が有り" & vbCrLf
  End If
  '変換後の文字列を戻す
  Me.TextBox1.Value = strIn
  strMsg = strMsg & "変換後の文字列 = " & strIn & vbCrLf
  strMsg = strMsg & "変換後の文字列長 = " & strLen
  MsgBox strMsg
End Sub

Function strInputCheck(sS As String, nLen As Long) As Long
  sS = StrConv(sS, vbNarrow)
  nLen = LenB(StrConv(sS, vbFromUnicode))
  If nLen * 2 = LenB(sS) Then
    strInputCheck = 0
  ElseIf nLen = LenB(sS) Then
    strInputCheck = 1
  Else
    strInputCheck = 2
  End If
End Function

【59792】Re:エクセルのマクロで文字判定
発言  初心者β  - 09/1/8(木) 19:57 -

引用なし
パスワード
   >
>Private Sub CommandButton1_Click()
>  Dim strIn  As String
>  Dim strLen As Long
>  Dim lngRst As Long
>  Dim strMsg As String
>  
>  strIn = Me.TextBox1.Value
>  If strIn = "" Then Exit Sub
>  If strInputCheck(strIn, strLen) <> 0 Then
>    strMsg = "全角が有り" & vbCrLf
>  End If
>  '変換後の文字列を戻す
>  Me.TextBox1.Value = strIn
>  strMsg = strMsg & "変換後の文字列 = " & strIn & vbCrLf
>  strMsg = strMsg & "変換後の文字列長 = " & strLen
>  MsgBox strMsg
>End Sub
>
>Function strInputCheck(sS As String, nLen As Long) As Long
>  sS = StrConv(sS, vbNarrow)
>  nLen = LenB(StrConv(sS, vbFromUnicode))
>  If nLen * 2 = LenB(sS) Then
>    strInputCheck = 0
>  ElseIf nLen = LenB(sS) Then
>    strInputCheck = 1
>  Else
>    strInputCheck = 2
>  End If
>End Function


ご丁寧にコードを書いて下さり有難うございます。
VISTAで動いているエクセル(バージョンが分からなかったです。新しいエクセルです)では問題なく動きましたが
別のパソコンWindows2000のエクセル2002では
エラーがでてしまいました。
sS = StrConv(sS, vbNarrow)の所が黄色く反転されます。

バージョンの問題でしょうか?

【59793】Re:エクセルのマクロで文字判定
回答  Abyss  - 09/1/8(木) 20:16 -

引用なし
パスワード
   > バージョンの問題でしょうか?

Library名を明記して通った記憶があります。

sS = StrConv(sS, vbNarrow)
   ↓
sS = VBA.StrConv(sS, vbNarrow)

【59809】Re:エクセルのマクロで文字判定
お礼  初心者β  - 09/1/9(金) 15:36 -

引用なし
パスワード
   ▼Abyss さん:
>> バージョンの問題でしょうか?
>
>Library名を明記して通った記憶があります。
>
>sS = StrConv(sS, vbNarrow)
>   ↓
>sS = VBA.StrConv(sS, vbNarrow)

ありがとうございます。
早速やってみれば違うところでエラーがでました。

ですが、同じように「VBA.」を付けてみましたらきちんと動きました。

大変助かり非常に感謝しております。
本当にありがとうございました。

3861 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free