xlAPPの役割とキャンセルの挙動の違い
- xlAPPがないと、キャンセルしても無視される
- xlAPPがどんな役割をしているのか、xlAPPがないと、なぜ無視されるのかがわかりません
- InputBoxを開いた時にキャンセルするふたつのプロシージャーを比較した時に、xlAPPがないコードは、キャンセルしても無視されます。xlAPPがない場合のInputBoxの形式も違います
- ベストアンサー
xlAPPがないと、キャンセルしても無視される
Sub xlAPPがある場合() Dim xlAPP As Application Dim strPathName As String, vntPathName As Variant Dim strFileName As String Set xlAPP = Application 'ここでわざとESCキーかキャンセルを押す vntPathName = xlAPP.InputBox("参照するフォルダ名を入力して下さい。", , "C:\") If VarType(vntPathName) = vbBoolean Then MsgBox "キャンセルがクリックされました" Exit Sub End If End Sub Sub xlAPPがない場合() Dim strPathName As String, vntPathName As Variant Dim strFileName As String 'ここでわざとESCキーかキャンセルを押す vntPathName = InputBox("参照するフォルダ名を入力して下さい。", , "C:\") ’無視される If VarType(vntPathName) = vbBoolean Then MsgBox "キャンセルがクリックされました" Exit Sub End If End Sub ************************************************** InputBoxを開いた時にキャンセルするふたつのプロシージャーを比較した時に、 xlAPPがないコードは、キャンセルしても無視されます。 xlAPPがどんな役割をしているのか、 xlAPPがないと、なぜ無視されるのかがわかりません。 あと、二つを比較すると、表示されるInputBoxの形式も違います。 ご教授よろしくお願いします。
- lkj23lkj
- お礼率100% (34/34)
- オフィス系ソフト
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
Application.InputBoxを使っているということは、No.1さんも書かれていますがExcel VBAですね。 xlAPPがないInputBoxでも、StrPtr関数でキャンセルを判別することができるそうです。 （公式の仕様ではないという話もあるようですが） Dim strPathName As String, vntPathName As Variant 'vntPathNameはString型にしても大丈夫なようです Dim strFileName As String 'ここでわざとESCキーかキャンセルを押す vntPathName = InputBox("参照するフォルダ名を入力して下さい。", , "C:\") If StrPtr(vntPathName) = 0 Then MsgBox "キャンセルがクリックされました" Exit Sub End If
その他の回答 (1)
- watabe007
- ベストアンサー率62% (476/760)
InputBoxは、2つあります。 ◆ApplicationオブジェクトのInputBoxメソッド 入力されたデータを「文字列」「数値」「数式」「セルへの参照」などとして取得できる。 [キャンセル]ボタンが選択された場合、False(理論値)が返される。 キャンセルの場合 If VarType(vntPathName) = vbBoolean Then MsgBox "キャンセルがクリックされました" Exit Sub End If ◆ InputBox 関数 入力されたデータはすべて文字列として取得される。 [キャンセル]ボタンが選択された場合、空の文字列("")が返される キャンセルの場合 If vntPathName = "" Then MsgBox "キャンセルがクリックされました" Exit Sub End If
お礼
どうもありがとうございました。
関連するQ&A
- アクセス InputBox キャンセルした場合を取
InputBoxでキャンセルしたら、キャンセルされましたと表示させたいのですが どうも私のやってるサンプルはエクセル専用のようです。 http://www.moug.net/tech/exvba/0100036.html 自分なりに書き換えてみたのですが キャンセルボタンを押しても無視されます。 Sub Sample() Dim returnData As Variant returnData = InputBox("データを入力してください") If VarType(returnData) = vbBoolean Then MsgBox "キャンセルされました" Exit Sub End If MsgBox "処理を続行します" End Sub アクセスではできないのでしょうか？ご教授よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBA フォルダ内の全てブックの特定の行の削除方法
VBAで質問させて下さい。 指定したフォルダ内にある全てのブックにて、セル「B35」が０だった場合、その行を削除する というコードが上手く動きません。 出来ない箇所：行の削除、処理済みのブックを閉じる 色々と検索しましたが分からなかったので、ご教授頂けると大変助かります。 どうぞよろしくお願いいたします。 ----------------------ここから↓----------------- Sub 修正() Dim xlAPP As Application Dim strPathName As String Dim strFileName As String Dim swESC As Boolean ' 「フォルダの参照」よりフォルダ名の取得 strPathName = BrowseForFolder("フォルダを指定して下さい", True) If strPathName = "" Then Exit Sub ' 指定フォルダ内のExcelワークブックのファイル名を参照する strFileName = Dir(strPathName & "\*.xls", vbNormal) If strFileName = "" Then MsgBox "このフォルダにはExcelワークブックは存在しません。" Exit Sub End If Set xlAPP = Application With xlAPP .ScreenUpdating = False ' 画面描画停止 .EnableEvents = False ' イベント動作停止 .EnableCancelKey = xlErrorHandler ' Escキーでエラートラップする .Cursor = xlWait ' カーソルを砂時計にする End With On Error GoTo Button1_Click_ESC ' 指定フォルダの全Excelワークブックについて繰り返す Do While strFileName <> "" ' Escキー打鍵判定 DoEvents If swESC = True Then ' 中断するのかをメッセージで確認 If MsgBox("中断キーが押されました。ここで終了しますか？", _ vbInformation + vbYesNo) = vbYes Then GoTo Button1_Click_EXIT Else swESC = False End If End If '----------------------------------------------------------------------- ' 検索した１ファイル単位の処理 Call OneWorkbookProc(xlAPP, strPathName, strFileName) '----------------------------------------------------------------------- ' 次のファイル名を参照 strFileName = Dir Loop GoTo Button1_Click_EXIT '---------------- ' Escキー脱出用行ラベル Button1_Click_ESC: If Err.Number = 18 Then ' EscキーでのエラーRaise swESC = True Resume ElseIf Err.Number = 1004 Then ' 隠しシートや印刷対象なしの実行時エラーは無視 Resume Next Else ' その他のエラーはメッセージ表示後終了 MsgBox Err.Description End If '---------------- ' 処理終了 Button1_Click_EXIT: With xlAPP .StatusBar = False ' ステータスバーを復帰 .EnableEvents = True ' イベント動作再開 .EnableCancelKey = xlInterrupt ' Escキー動作を戻す .Cursor = xlDefault ' カーソルをデフォルトにする .ScreenUpdating = True ' 画面描画再開 End With Set xlAPP = Nothing End Sub '******************************************************************************* ' １つのワークブックの処理 '******************************************************************************* Private Sub OneWorkbookProc(xlAPP As Application, _ strPathName As String, _ strFileName As String) Dim R As Range '--------------------------------------------------------------------------- Dim objWBK As Workbook ' ワークブックObject ' ステータスバーに処理ファイル名を表示 xlAPP.StatusBar = strFileName & "修正中．．．．" ' ワークブックを開く Set objWBK = Workbooks.Open(Filename:=strPathName & cnsYEN & strFileName, _ UpdateLinks:=True, _ ReadOnly:=False) '--------------------------------------------------------------------------- ' ↓↓↓ 検索した１ファイル単位の処理 ↓↓↓ Set R = ActiveSheet.Range("B35").Find(What:="0", LookAt:=xlWhole) If R Is Nothing Then Exit Sub R.EntireRow.Delete ' ↑↑↑ 検索した１ファイル単位の処理 ↑↑↑ '--------------------------------------------------------------------------- ' 開いたブックをClose objWBK.Close SaveChanges:=True Set objWBK = Nothing End Sub
- ベストアンサー
- Excel（エクセル）
- キャンセルボタンをクリックしたかどうかを取得したい
InputBoxでもしキャンセルボタンが押されたら・・・ってどうやればいいですか？ Sub あああ() Dim a As String a = InputBox("文字を入れてください。") MsgBox a End Sub をした時に、キャンセルボタンをクリックしたかどうかを取得したいのですが、どうすればいいんですか？ a = InputBox("文字を入れてください。") の次に Cancel = True をいれても vbCancel = True をいれてもエラーになります。 Sub あああ() Dim a As String a = InputBox("文字を入れてください。") If a = "" Then MsgBox "キャンセルが押されました" End If End Sub これだとＯＫでもキャンセルでもメッセージが表示されます。
- ベストアンサー
- オフィス系ソフト
- InputBox String型・Variant
ＶＢＡです。 InputBox String型・Variant型がエラーにならない理由がわかりません。 Sub 日付型() Dim 日 As Date 日 = InputBox("値をいれてください") End Sub Sub 数値型() Dim i As Long i = InputBox("値をいれてください") End Sub Sub 通貨型() Dim 円 As Currency 円 = InputBox("値をいれてください") End Sub Sub String型() Dim a As String a = InputBox("値をいれてください") End Sub Sub Variant型() Dim v As Variant v = InputBox("値をいれてください") End Sub String型・Variant型以外は、 「実行時エラー '13'; 型が一致しません。」になります。 String型・Variant型はならない理由を教えてください。ご回答よろしくお願いします。
- ベストアンサー
- Visual Basic
- VBAの初心者でやりたいことがあるのですが、どうやっていいのか分かりま
VBAの初心者でやりたいことがあるのですが、どうやっていいのか分かりません。 やりたいことは 1.フォルダを指定してCSVファイルを読み込む。 2.読み込んだCSVファイルを一行あたり1ファイルのエクセルファイルに書き込む。 3.完成したエクセルファイルを印刷する。 4.フォルダの中のファイルが無くなれば終了 としたいのですが、途中で頓挫しています。 宜しくお願いします。 Option Explicit sub READ_TextFile() Const cnsTITLE = "フォルダ内のファイル名一覧取得" Const cnsDIR = "\*.*" Dim xlAPP As Application Dim strPATHNAME As String Dim strFILENAME As String Dim GYO As Long Const cnsFILTER = "全てのファイル (*.*),*.*" Dim xlAPP2 As Application' Applicationオブジェクト Dim intFF As Integer' FreeFile値 Dim X() As Variant' 読み込んだレコード内容 Dim IX1 As Long' CSV項目カラムINDEX Dim lngREC As Long' レコード件数カウンタ Dim strREC As String' レコード領域 Dim POS1 As Long' レコード文字位置 Dim POS2 As Long' レコード文字位置 Set xlAPP = Application strPATHNAME = xlAPP.InputBox("フォルダ名を入力して下さい。", _ cnsTITLE, "C:\Documents and Settings\hidekazu_miyawaki\デスクトップ\") If StrConv(strPATHNAME, vbUpperCase) = "FALSE" Then Exit Sub If Dir(strPATHNAME, vbDirectory) = "" Then MsgBox "指定のフォルダは存在しません。", vbExclamation, cnsTITLE Exit Sub End If strFILENAME = Dir(strPATHNAME & cnsDIR, vbNormal) Set xlAPP2 = Application Do While strFILENAME <> "" GYO = GYO + 1 Cells(GYO, 1).Value = strFILENAME strFILENAME = Dir() Open strFILENAME For Input As #intFF GYO = 1 Do Until EOF(intFF) lngREC = lngREC + 1 xlAPP2.StatusBar = "読み込み中です(" & lngREC & "レコード目)" Line Input #intFF, strREC POS1 = 1 IX1 = 0 ReDim X(IX1) Do While POS1 <= Len(strREC) POS2 = InStr(POS1, strREC, ",", vbTextCompare) If POS2 < POS1 Then POS2 = Len(strREC) + 1 End If ReDim Preserve X(IX1) X(IX1) = Trim$(Mid$(strREC, POS1, POS2 - POS1)) If (((Left$(X(IX1), 1) = """") And (Right$(X(IX1), 1) = """")) Or _ ((Left$(X(IX1), 1) = "'") And (Right$(X(IX1), 1) = "'"))) Then X(IX1) = Trim$(Mid$(X(IX1), 2, Len(X(IX1)) - 2)) End If POS1 = POS2 + 1 IX1 = IX1 + 1 Loop GYO = GYO + 1 If IX1 >= 1 Then Range(Cells(GYO, 1), Cells(GYO, IX1)).Value = X End If Loop Loop Close #intFF xlAPP.StatusBar = False MsgBox "ファイル読み込みが完了しました。" & vbCr & _ "レコード件数=" & lngREC & "件", vbInformation, cnsTITLE End Sub
- ベストアンサー
- Visual Basic
- OKを押してもキャンセルを押しても、反応しない
このコード、どこが間違ってるか教えてもらえますか？ Sub test() Dim ret As Variant ret = InputBox("タイトルを入力してください。") If TypeName(ret) = "Boolean" Then MsgBox "キャンセルが選択されました" End If End Sub これで、キャンセルボタンを押しても、メッセージボックスが表示されません。 間違えてる部分がわかりません。
- ベストアンサー
- オフィス系ソフト
- VBA実行時のエラー
下記のプログラムは私が作った物では無いのですが、作った方と連絡をとる事が出来なくなってしまった為、質問させて頂きます。 このプログラムをシートから実行した所 エラー：400『既にフォームは表示されています。モーダルにできません。』 なるものが表示されてしまいます。 またコードを記述する所から実行しますと 実行時エラー：１００４『アプリケーション定義またはオブジェクト定義のエラー』 となってしまいます。 私の努力が足りないのは重々承知ですが、解決する事が出来ません。 皆様のお力を借りることが出来たらと思い投稿しました。 宜しくお願い致します。 Sub syoutotumen() Dim i As Long Dim j As Long Dim k As Long Dim kyori As Long Dim n As Integer n = 1 i = 1 j = 1 k = 1 Const cnsYEN = "\" Dim xlAPP As Application Dim objWBK As Workbook Dim strPATHNAME As String Dim strFILENAME As String strPATHNAME = "C:\Documents and Settings\tata41\デスクトップ\画像処理\" If strPATHNAME = "" Then Exit Sub strFILENAME = Dir(strPATHNAME & "dem******", vbNormal) If strFILENAME = "" Then MsgBox "このフォルダにはExcelワークブックは存在しません" Exit Sub End If Set xlAPP = Application With xlAPP .ScreenUpdating = False .EnableEvents = Fales .EnableCancelKey = xlErrorHandler .Cursor = xlWait End With Set WS1 = Worksheets("sheet1") Range("A1") = "0" Range("A2") = "1" Range("A1:A2").Select Selection.AutoFill Destinaton:=Range("A1:A512") Do While strFILENAME <> "" DoEvents If swESC = True Then If MsgBox("ESCが押されました。ここで終了しますか？", vbInformation + vbYesNo) = vbYes Then GoTo Button1_Click_Exit Else swESC = False End If End If xlAPP.StatusBar = trFILENAME & "処理中..." Set objWBK = Workbooks.Open(Filename:=strPATHNAME & cnsYEN & strFILENAME, UpdateLinks:=False, ReadOnly:=True) Do If Cells(i, 2) = 255 Then Exit Do i = i + 1 Loop Do If Cells(j, 3) = 255 Then Exit Do j = j + 1 Loop Do If Cells(k, 4) = 255 Then Exit Do k = k + 1 Loop kyori = (i + j + k - 21) / 3 WS1.Cells(n, 2) = kyori n = n + 1 i = 1 j = 1 k = 1 objWBK.Close savechanges:=False strFILENAME = Dir Loop GoTo Button1_Click_Exit Button1_Click_ESC: If Err.Number = 18 Then swESC = True Resume ElseIf Err.Number = 1004 Then Resume Next Else MsgBox Err.Description End If Button1_Click_Exit: With xlAPP .StatusBar = False .ScreenUpdating = True .EnableEvents = True .EnableCancelKey = xlInterrupt .Cursur = xlDefault Set objWBK = Nothing Set xlAPP = Nothing End With End Sub
- ベストアンサー
- オフィス系ソフト
- VBAにてアクティブでは無いシートの値が参照されてしまいます。
こんばんは、以前二回程質問させていただいた物です。 過去のアドバイスから少しずつ疑問をつぶしていった所再び問題が発生してしまいました。 同じプログラムを何度も載せるのは大変恐縮ですが、どうしても解決出来ない為(私の努力不足は重々承知です)皆様の力を貸して頂きたいと思います。 以下のようなループの際、途中にMsgBox(strFILENAME)を入れたり、Active.sheetでウオッチ式で見ても参照してほしいシート名を表示するにも関わらず、計算結果を書き込むシートのセルを参照してしまいます。 なぜ、WS1のセルの値を参照してしまうのかわからず困っています。 確実にMsgBox(strFILENAME)で表示されるファイル名のシートのセルを参照する方法を教えて頂きたく、よろしくお願いいたします。(Workbook.Worksheet.のように明示する方法を教えていただいたのですがエラーが発生してしまいうまく使いこなすことが出来ませんでした) どうか、宜しくお願いいたします。 Option Explicit Sub syoutotumen() Dim i As Long Dim j As Long Dim k As Long Dim kyori As Long Dim n As Integer n = 1 i = 1 j = 1 k = 1 Const cnsYEN = "\" Dim swESC As Boolean Dim ws1 As Worksheet Dim xlAPP As Application Dim objWBK As Workbook Dim strPATHNAME As String Dim strFILENAME As String strPATHNAME = "C:\Documents and Settings\tata41\デスクトップ\画像処理２\" If strPATHNAME = "" Then Exit Sub strFILENAME = Dir(strPATHNAME & "demo******", vbNormal) If strFILENAME = "" Then MsgBox "このフォルダにはExcelワークブックは存在しません" Exit Sub End If Set xlAPP = Application With xlAPP .ScreenUpdating = False .EnableEvents = False .EnableCancelKey = xlErrorHandler .Cursor = xlWait End With Set ws1 = Worksheets("sheet1") Range("A1") = "0" Range("A2") = "1" Range("A1:A2").Select Selection.AutoFill Destination:=Range("A1:A1022") Do While strFILENAME <> "" DoEvents If swESC = True Then If MsgBox("ESCが押されました。ここで終了しますか？", vbInformation + vbYesNo) = vbYes Then GoTo Button1_Click_Exit Else swESC = False End If End If xlAPP.StatusBar = strFILENAME & "処理中・・・" Set objWBK = Workbooks.Open(Filename:=strPATHNAME & cnsYEN & strFILENAME, UpdateLinks:=False, ReadOnly:=True) Do If Cells(i, 2) = 0 Then Exit Do i = i + 1 Loop Do If Cells(j, 3) = 0 Then Exit Do j = j + 1 Loop Do If Cells(k, 4) = 0 Then Exit Do k = k + 1 Loop kyori = (i + j + k - 21) / 3 ws1.Cells(n, 2) = kyori n = n + 1 i = 1 j = 1 k = 1 objWBK.Close savechanges:=False strFILENAME = Dir Loop GoTo Button1_Click_Exit Button1_Click_ESC: If Err.Number = 18 Then swESC = True Resume ElseIf Err.Number = 1004 Then Resume Next Else MsgBox Err.Description End If Button1_Click_Exit: With xlAPP .StatusBar = False .ScreenUpdating = True .EnableEvents = True .EnableCancelKey = xlInterrupt .Cursur = xlDefault Set objWBK = Nothing Set xlAPP = Nothing End With End Sub
- ベストアンサー
- オフィス系ソフト
- vba InputBox キャンセルなら
Sub test() Dim i As Long i = InputBox("値をいれてください") 'キャンセルなら 'if then exit sub End Sub このような状態で、キャンセルボタンを押すかescキーを押したら、 'キャンセルなら 'if then exit sub でプロシージャーを抜けたいのですが、 キャンセルボタンを押すと、実行時エラー１３になります。 （_型が一致しません。(Error13)） エラーを発生させずに、キャンセルさせるにはどうすればいいですか？
- 締切済み
- オフィス系ソフト
- InputBox キャンセルボタンが押された時の処理
こんばんは。 Sub test() Dim タイトル As String タイトル = InputBox("タイトルを入力してください。") If Cancel = True Then Exit Sub ’次のコード・・・ ’次のコード・・・ End Sub このコードを実行した時に 下記のダイアログが出てきて 右のキャンセルボタンを押すと、 「If Cancel = True Then Exit Sub」 でsubステートメントを抜けたいのですが 「Cancel」の部分が 「変数が定義されていません」とエラーになってしまいます。 Dim Cancel As Boolean を追加してキャンセルボタンを押しても TrueではなくFalseになってしまいます。 回避方法を教えてください。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
お礼
どうもありがとうございました。