エクセルVBA、入力しないと閉じないInputBox

質問

必ず何かを入力しないと閉じないInputBoxを作ろうと思います。
以下のコードで入力がなければ閉じないというか、Line:に戻るので、何度でも現れるInputBoxになるようですが、このやり方は正しいですか？
通常はどうやるのでしょうか？

Sub test()
Dim a
line:
a = Application.InputBox("必ず入力して下さい。", "Input!")
If Len(a) = 0 Or a = False Then GoTo line
MsgBox "有難う。" & a & " ですね。", , "(o。_。)oペコッ"
End Sub

回答No.1

j_nishiz · ベストアンサー

手元のExcel2007で動かしてみたらちゃんと動きますね。
（我ながら暇だ。）

間違ってませんが、Goto文は避けるように、というのがお約束ですので

Sub test2()
Dim a

Do Until Len(a) > 0
a = Application.InputBox("必ず入力して下さい。", "Input!")
Loop
MsgBox "有難う。" & a & " ですね。", , "(o。_。)oペコッ"
End Sub

こんなんでどうでしょう。

お礼

早速有難うございました。Do～Loopを使うんですね。
Do Until Len(a) > 0 And a <> False
でやってみました。
ぜんぜん別の話ですが、キャンセルのFalseと手入力のFalseを区別してくれないのが困りものです・・・・。

回答No.7

kobouzu_su

エキスパートさん、こんにちは。

（１）Do Until Len(a) > 0 And a <> False　の件

次のコードを試してみてください。

'------------------------------------------------
Sub Test()
　Dim A, B
　A = Application.InputBox(vbLf & "キャンセルをクリックせよ")
　B = Application.InputBox(vbLf & "false　を入力せよ")

　MsgBox _
　　"キャンセル (A)" & vbLf & vbLf & _
　　"A = false -> " & (A = False) & vbLf & _
　　"A = ""false"" -> " & (A = "false") & vbLf & vbLf & _
　　"false入力 (B)" & vbLf & vbLf & _
　　"B = false -> " & (B = False) & vbLf & _
　　"B = ""false"" -> " & (B = "false")

End Sub
'-----------------------------------------------------

この結果から分かるように、手入力されたfalseは、
恰も論理値のFalseと文字列の"false"の２つの値をとっているような振る舞いをしていることが分かります。
ですから、

＞Do Until Len(a) > 0 And a <> False

この a<>false　では、キャンセルのfalseと手入力の"false"を区別できないわけです。
で、手入力のfalseを区別するためには

Do Until (Len(a) > 0 And a <> False) Or a = "false"　

このように、a="false"を追加してやればいいことになります。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

（２）Loopのところに条件をセットするの件

＞どう試しても同じ結果にしかならないようなのです

今回の場合は結果は変りません。
なので、「今回のような場合には」と言ったわけです。

＞Do Until Len(a) > 0 And VarType(a) <> vbBoolean
＞　a = Application.InputBox("必ず入力して下さい。", "Input!")
＞Loop

上記では条件になるaの値は、Do Loopの中で初めて決まるにも拘わらず
いきなりDoのところで判定をしていますのでそこが拙いのです。

次をお試しください。

'-----------------------------------------------
Sub bbb()
　Dim a

　a = 5

　Do Until Len(a) > 0 And VarType(a) <> vbBoolean
　　a = Application.InputBox("必ず入力して下さい。", "Input!")
　Loop

　MsgBox a & " ですね。"
End Sub
'------------------------------------------

今回はDo Loopに入る前には、Do Loopを抜けるような、aの値は入ってないのでたまたま上手くいったわけですが、
もし上記のように、Do Loopに入る前に、Do Loop を抜ける値がaに入っていた場合はどうでしょう。
何もしないうちにDo Loopを抜けることになります。

どうでしょう、納得できましたでしょうか。

もし、エキスパートさんが分からないと思ってることと、
当方の意図してるところが違ってましたら、ペコリ～、ということで。(^^;;;

以上です。

お礼

お大師、kobouzu_suさま、いつもありがたい教えを感謝いたします。
よく分かりました。
これからもよろしくお願いします。

回答No.6

KenKen_SP

賑わってますねw

既に解決済みだと思いますので、お遊びのキワモノコードを。。。
入力しないと OK も キャンセル もクリックできない、InputBoxEx です。

' // 標準モジュール

Option Explicit

Private Declare Function SetTimer Lib "user32.dll" ( _
　　 ByVal hWnd As Long, _
　　 ByVal nIDEvent As Long, _
　　 ByVal uElapse As Long, _
　　 ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" ( _
　　 ByVal hWnd As Long, _
　　 ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
　　 ByVal lpClassName As String, _
　　 ByVal lpWindowName As String) As Long
Private Declare Function GetDlgItem Lib "user32.dll" ( _
　　 ByVal hDlg As Long, _
　　 ByVal nIDDlgItem As Long) As Long
Private Declare Function EnableWindow Lib "user32.dll" ( _
　　 ByVal hWnd As Long, _
　　 ByVal fEnable As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
　　 ByVal hWnd As Long, _
　　 ByVal wMsg As Long, _
　　 ByVal wParam As Long, _
　　 ByRef lParam As Any) As Long

Private Const WM_GETTEXT As Long = &HD
Private Const MAX_PATH　 As Long = 256

Private msInputBoxTitle As String
Private mfFirstCall　　　As Boolean

' // 強制入力 InputBox
Public Function InputBoxEx( _
　　　 ByVal Prompt As String, _
　　　 Optional ByVal Title As String = "Microsoft Excel" _
) As String

　　Const INTERVAL As Long = 10

　　Dim TimerID As Long
　　mfFirstCall = True
　　msInputBoxTitle = Title
　　TimerID = SetTimer(0&, 0&, INTERVAL, AddressOf CallBackInputBoxEx)
　　InputBoxEx = InputBox(Prompt, Title)
　　Call KillTimer(0&, TimerID)

End Function

' // Timer コールバック関数
Private Sub CallBackInputBoxEx( _
　　ByVal hWnd As Long, _
　　ByVal uMsg As Long, _
　　ByVal idEvent As Long, _
　　ByVal dwTime As Long _
)

　　Dim hEdit　 As Long
　　Dim hBtn1　 As Long
　　Dim hBtn2　 As Long
　　Dim sBuffer As String
　　Dim lPos　　As Long

　　hWnd = FindWindow("#32770", msInputBoxTitle)
　　If hWnd > 0 Then
　　　　hEdit = GetDlgItem(hWnd, &H1324)
　　　　hBtn1 = GetDlgItem(hWnd, &H1&)
　　　　hBtn2 = GetDlgItem(hWnd, &H2&)
　　　　If mfFirstCall Then
　　　　　 Call EnableWindow(hBtn1, 0&)
　　　　　 Call EnableWindow(hBtn2, 0&)
　　　　　 mfFirstCall = False
　　　　Else
　　　　　 sBuffer = String$(MAX_PATH, Chr(0))
　　　　　 Call SendMessage(hEdit, WM_GETTEXT, MAX_PATH, ByVal sBuffer)
　　　　　 sBuffer = Replace$(sBuffer, Chr(0), "")
　　　　　 If Len(sBuffer) > 0 Then
　　　　　　　Call EnableWindow(hBtn1, 1&)
　　　　　 Else
　　　　　　　Call EnableWindow(hBtn1, 0&)
　　　　　 End If
　　　　End If
　　End If

End Sub

' // 以下は使い方サンプル
Sub SampleProc()
　　Dim s As String
　　s = InputBoxEx("入力しないと閉じることができない？", "強制入力Sample")
　　MsgBox s
End Sub

お礼

KenKen_SPさま、いつもお世話様です。

これは入力しないとボタンを全部無効にしてしまうのですね！
凄いです。
有難うございました。

回答No.5

kobouzu_su

エキスパートさん、こんばんは。
毎日、暑ーーーーーーい、ですねぇ。

既に解決済みのようですが、例によってお節介。(^^;;;

＞If Len(a) = 0 Or a = False Then GoTo line
とか
＞Do Until Len(a) > 0 And a <> False

これがなぜ拙いのかお分かりでしょうか？
それが分からなければ本当の意味での解決にはならないのではないのでしょうか。
是非、そこのところを考えてみてください。

そして、今回のような場合に、Do Loopを使うときは

＞Do 　●Until Len(a) > 0 And VarType(a) <> vbBoolean●
＞a = Application.InputBox("必ず入力して下さい。", "Input!")
＞Loop

上記のように、条件●をDoのところに書かずに

＞Do
＞a = Application.InputBox("必ず入力して下さい。", "Input!")
＞Loop 　●Until Len(a) > 0 And VarType(a) <> vbBoolean●

このように、Loopのところに書くべきです。
ちょっと考えてみると分かると思います。
スーパーエキスパートWendy02さんの回答でもそうなってますよね。

そしてまた、Goto文は場合によってはそれを使うことで、シンプルなコードを書くことができますので、一概には使用禁止、とはならないと考えます。

それはともあれ、少なくとも最初の件は是非考えてみてください。
そんなんは、百も承知の助、ということであれば、あちゃー、というほかありませんが。。(^^;;;
以上です。

お礼

> これがなぜ拙いのかお分かりでしょうか？
> それが分からなければ本当の意味での解決にはならないのではないのでしょうか。
> 是非、そこのところを考えてみてください。

すみません、ずっと考えていましたがわかりません。

> そして、今回のような場合に、Do Loopを使うときは

これも、
Sub aaa()
Do
a = Application.InputBox("必ず入力して下さい。", "Input!")
Loop Until Len(a) > 0 And VarType(a) <> vbBoolean
MsgBox a & " ですね。"
End Sub
と
Sub bbb()
Do Until Len(a) > 0 And VarType(a) <> vbBoolean
a = Application.InputBox("必ず入力して下さい。", "Input!")
Loop
MsgBox a & " ですね。"
End Sub
を、どう試しても同じ結果にしかならないようなのです・・・

おてあげです。
すみません。

回答No.4

Wendy02

こんにちは。

混乱させるつもりではありませんが、キャンセル不可なら、このようにしても出来ます。

Sub test()
Dim a As Variant　'明示的にデータ型は入れます。
Do
　a = Application.InputBox("必ず入力して下さい。", "Input!", Type:=2)
Loop Until a <> "" And VarType(a) <> vbBoolean
MsgBox "有難う。" & a & " ですね。", , "(o。_。)oペコッ"

End Sub

ただ、プログラミングとしては、通常、ユーザーの選択肢としては、キャンセル・クリックの余地を残しておいたほうがよいと思います。

>何度でも現れるInputBoxになるようですが、このやり方は正しいですか？

ネットの中では、goto 方式は、理屈抜きに批判する人がいるというだけで、現実の問題としては、goto 方式でも悪くはありません。

かつて、「構造化プログラミング」とは、「goto」を排除することだと、一般プログラマーが誤解するようになったからで、実際問題、「goto」を抜きに書いて、それだけで、構造化プログラムが達成するわけでもありません。概して、VBAやVBで、「goto」を連発してコードを書く人は、技術的に低いのは事実ですが、「なし」にして、必ずしも、ベストとは言えません。

それと、InputBox 関数は、レガシーですから、現在では、なるべく、戻り値のデータ型を指定して、InputBox メソッドを使うようにしたほうがよいですね。

お礼

> InputBox 関数は、レガシーですから

レガシーって古いシステムのことですね？
ありがとうございました。

回答No.3

yukika-37

>たしかに文字列のFalseは認識されますが、今度はキャンセルが可能になってしまい、入力しないと閉じないInputBoxではなくなっています。

キャンセル不可にしたいということでしょうか？
それでしたら、こんな感じでしょうか。

Sub test4()
Dim a

Do
a = InputBox("必ず入力して下さい。", "Input!")
Loop Until Len(a) > 0

MsgBox "有難う。" & a & " ですね。", , "(o。_。)oペコッ"

End Sub

お礼

なるほど、Application.InputBoxではなくInputBoxを使うんですね。これならキャンセルで空白が返りますから間違いませんね。

回答No.2

yukika-37

Sub test3()
Dim a

Do
a = Application.InputBox("必ず入力して下さい。", "Input!")
Loop Until Len(a) > 0

If VarType(a) <> vbBoolean Then
MsgBox "有難う。" & a & " ですね。", , "(o。_。)oペコッ"
End If

End Sub

＃１さんとほぼ同じです。
文字列として"False"を入力した場合はメッセージボックスが出るようにしてみました。

お礼

有難うございます。
たしかに文字列のFalseは認識されますが、今度はキャンセルが可能になってしまい、入力しないと閉じないInputBoxではなくなっています。

補足

Sub test3()
Dim a
Do Until Len(a) > 0 And VarType(a) <> vbBoolean
a = Application.InputBox("必ず入力して下さい。", "Input!")
Loop
MsgBox "有難う。" & a & " ですね。", , "(o。_。)oペコッ"
End Sub
で、文字列のFalseは認識されますがキャンセル不可となり、うまく行きました。
ありがとうございます。