Results of 1 - 1 of about 85 for VBA 強制終了 (0.004 sec.)
vba (14708), 強制終了 (237)
- [[20190715202938]]
- #score: 16278
- @digest: 6d825ec4666dddcd2c424713ed239a8e
- @id: 80208
- @mdate: 2019-07-17T15:47:26Z
- @size: 21421
- @type: text/plain
- #keywords: chip (32343), ト移 (13824), 字デ (10704), 渡辺 (10085), activeworkbook (7141), 辺ひ (5603), ー先 (3601), target (3253), 2019 (3129), ロシ (2735), 火) (2616), boolean (2483), nothing (2258), チェ (2089), シー (2028), ダイ (1994), 問者 (1913), ック (1898), ェッ (1892), イベ (1855), string (1812), ブッ (1766), 終了 (1592), workbook (1559), ベン (1519), ート (1459), コピ (1433), 発生 (1386), 対象 (1371), 以降 (1364), ピー (1343), name (1299)
- 『マクロ実行後、シートのコピーが手動でもできなくなる』（chip）
マクロの内容は、 1,コピー先のシートをダイヤログで選択してもらいブックを開く。 1-2,この時キャンセルされるとマクロ停止。 2,コピー元に戻りアクティブシートをコピー先にコピーする。 3,コピー元のシートにはシートモジュールが組み込まれているシートがあるので、コピー先の拡張子が.xlsmでは無かったら、拡張子を変更して名前をつけて保存して元の拡張子のブックを削除する。 4,コピー先のブックを閉じてマクロは終了。 この流れになってます。1度目の実行はできるのですが、再度同じコピー先にシートをコピーしようとすると、シートコピーするところでエクセルが強制終了されます。 この現象はマクロで実行、手動でシートコピーどちらでも発生します。 ですが、1回目のマクロ実行後にコピー先のシートを開きなにもせずに保存し閉じた後にマクロを実行すると正常に実行でき、次は同様の事象が発生してしまいます。 以下コードです。※手打ちしているため間違えてるかもしれませんが1回目は正しく動作します。 Sub マクロ登録() Dim tbook As String Dim wb As Workbook Dim stopM As Boolean tbook=ActiveWorkbook.Name Set wb=Workbooks(tbook) Call シート移動(stopM) ‾‾‾‾ Sub シート移動(ByRef f As Boolean) Dim Myname As String Dim wb1 As Workbook,wb2 As Workbook Dim ws As Workseet,w As Worksheet Dim flag As Boolean Set wb1=ActiveWorkbook Set ws=ActiveSheet With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect=True .InitialFileName=“¥¥〇〇○“ If .Show=-1 Then .Execute Else f=True Exit Sub End If End With Set wb2=ActiveWorkbook wb1.Activate ws.Copy After:=wb2.Sheets(1) Myname=InputBox(“シート名入力”) ActiveSheet.Name=Myname Set wb1=Nothing Set wb2=Nothing Set ws=Nothing End Sub ‾‾‾‾‾ If stopM Then Exit Sub'シート移動のダイヤログで開く以外の操作した場合はマクロ終了 Call ファイル保存 ‾‾‾‾‾ Dim fso As Object Dim n As String,ff As String,x As String,fu As String Set fso = CreateObject(“Scriping.FileSystemObject”) ff=ActiveWorkbook.FullName fn=ActiveWorkbook.Name x=“.” & fso.GetExtensionName(ff) n=Left(fn,Len(fn)-Len(x)) If x = “.xlsm” Then ActiveWorkbook.Save ActiveWorkbook.Close Else ActiveWorkbook.SaveAs Filename:=“¥¥○〇〇¥” & n & _ “.xlsm”,FileFormat:=xlOpenXMLWorkbookMacroEnabled ActiveWorkbook.Close Kill ff End If Set fso=Nothing End Sub ‾‾‾‾‾‾‾‾‾‾‾ wb.Activate シートをリセットするコードが入る。 Set wb=Nothing End Sub ＜ 使用 Excel:Excel2016、使用 OS:Windows10 ＞ ---- プロシージャの最初と最後が不明です。 あなたの入力ミスと判別不能ですので、 デバッグ依頼として不成立です。 （γ） 2019/07/15(月) 22:12 ---- γさん申し訳ございません。再度貼り付けます。 Sub マクロ登録() Dim tbook As String Dim wb As Workbook Dim stopM As Boolean tbook=ActiveWorkbook.Name Set wb=Workbooks(tbook) Call シート移動(stopM) If stopM Then Exit Sub'シート移動のダイヤログで開く以外の操作した場合はマクロ終了 Call ファイル保存 wb.Activate Set wb=Nothing End Sub ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ Sub ファイル保存() Dim fso As Object Dim n As String,ff As String,x As String,fu As String Set fso = CreateObject(“Scriping.FileSystemObject”) ff=ActiveWorkbook.FullName fn=ActiveWorkbook.Name x=“.” & fso.GetExtensionName(ff) n=Left(fn,Len(fn)-Len(x)) If x = “.xlsm” Then ActiveWorkbook.Save ActiveWorkbook.Close Else ActiveWorkbook.SaveAs Filename:=“¥¥○〇〇¥” & n & _ “.xlsm”,FileFormat:=xlOpenXMLWorkbookMacroEnabled ActiveWorkbook.Close Kill ff End If Set fso=Nothing End Sub ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ Sub シート移動(ByRef f As Boolean) Dim Myname As String Dim wb1 As Workbook,wb2 As Workbook Dim ws As Workseet,w As Worksheet Dim flag As Boolean Set wb1=ActiveWorkbook Set ws=ActiveSheet With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect=True .InitialFileName=“¥¥〇〇○“ If .Show=-1 Then .Execute Else f=True Exit Sub End If End With Set wb2=ActiveWorkbook wb1.Activate ws.Copy After:=wb2.Sheets(1) Myname=InputBox(“シート名入力”) ActiveSheet.Name=Myname Set wb1=Nothing Set wb2=Nothing Set ws=Nothing End Sub （chip） 2019/07/15(月) 22:23 ---- まず、質問者が行なっていることは、自己増殖型のウィルスソフトであると判断されてもおかしくないことを認識して下さい。 目的を達成する手段としては、別なアプローチがあると考えます。 で、問題ですが、コピー元のシートモジュールにどんなコードが書かれているのでしょうか? 考えられる事としては、変数、定数の競合、シートオブジェクト名の異常などがあります。 （渡辺ひかる） 2019/07/15(月) 22:51 ---- 渡辺ひかるさん回答ありがとうございます。 マクロを触りだしたところでそのような認識はありませんでした。 コピー元のシートモジュールは以下です。 指定したセルが選択されるとチェックと日付が入力されるようになってます。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim ma As String ma = Range("D2")'入力されている最大行数をD2セルに関数算出してます。 If Target.CountLarge > 1 Then Exit Sub With Target If Not .Column = 7 Then Exit Sub End With If Target.Row < 19 Then Exit Sub If Target.Row > ma Then Exit Sub If Target.Value = "" Then Target.Value = "P" Target.Font.Name = "Wingdings 2" Target.Offset(, 2).Value = Date ElseIf Target.Value = "-" Then Exit Sub Else Target.Offset(, 2).Value = "" Target.Offset(, 0).Value = "" End If Set Target = Nothing End Sub （chip） 2019/07/15(月) 23:36 ---- ■ とりあえず、こだわり無いならインデント付けたほうがいいとおもいます。 （誰かに見せるつもりなら、見やすいほうがよいでしょうし、見やすくなればご自身のデバッグ作業もはかどりますよ） ■ ↓で複数ブックを選択可能にしてますが、提示されたコードだと複数選択されると困りませんか? .AllowMultiSelect = True ■ ダメとはいいませんが、個人的にはActive○○に依存するコードは避けたほうがよいとおもいます。 ■ プロシージャを複数に分けてますが、何か目的あるんでしょうか? 本件の場合は複雑化するだけなのでやめたほうがよいような・・ ■ 投稿されたコードに、インデントとコメント付けつつ合体させて、さらにループ処理に変えてみました。 興味があればステップ実行して、研究（各変数に何が格納されるか、どのような挙動になるか）してみてください。 （部分的にはテストしましたけど、全体はコンパイルエラーにならないことしかチェックしてないのでミスっていたらごめんなさい。） Sub 合体() Const MyPath As String = "¥¥〇〇○" Dim buf As Variant Dim srcSH As Worksheet: Set srcSH = ActiveSheet Dim tmp As String '▼ダイアログを開いてユーザーにブックを選択させる（複数可） With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .InitialFileName = MyPath '▼キャンセル等が押されたらプログラム終了 If .Show = 0 Then Exit Sub '▼ループ処理 For Each buf In .SelectedItems '▼ブックを開いて操作対象に With Workbooks.Open(buf) '▼シートをコピーしてユーザーに名前を入力してもらう srcSH.Copy After:=.Sheets(1) .Sheets(2).Name = InputBox("シート名入力") '▼（開いたブックの）拡張子を除いたブック名を取得 tmp = Left(.Name, InStrRev(.Name, ".") - 1) '▼（開いたブック）を名前を付けて保存して閉じる(同名ファイルがあっても強制上書き) Application.DisplayAlerts = False .SaveAs _ Filename:=MyPath & tmp, _ FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.DisplayAlerts = True .Close End With Next buf End With End Sub （もこな2） 2019/07/16(火) 01:51 ---- シートイベントのほうも、いちいち選択しなおすたびにマクロが発動するのも煩わしいとおもうので、BeforeDoubleClickイベントに変更して整理してみました。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True With Target '▼処理対象か判定 If Not .Column = 7 Then Exit Sub If .Row < 19 Then Exit Sub If .Row > Range("D2").Value Then Exit Sub '▼Targetの値で条件分岐 Select Case .Value Case "" .Value = "P" .Font.Name = "Wingdings 2" .Offset(, 2).Value = Date Case "-" '何もしない Case Else .Offset(, 2).Value = "" .Value = "" End Select End With End Sub （もこな2） 2019/07/16(火) 02:08 ---- ＞シートコピーするところでエクセルが強制終了されます。 肝心の質問の方は私には原因はわかりませんが、どの部分で落ちるかわかっているということは、ステップ実行して調べた結果でしょうか? もし、そうでなくて、ただの推測だったら、一度ステップ実行してみて確認したほうがよいとおもいます。 x=“.” & fso.GetExtensionName(ActiveWorkbook.FullName) If x = “.xlsm” Then ActiveWorkbook.Close ↑のようになっているので、正常に終了されているだけという可能性を疑っています。 （もこな2） 2019/07/16(火) 03:05 ---- もこな2さん ありがとうございました!とても勉強になりました! 思う通りの動きになり、不具合の発生もありませんでした。 シートモジュールに関しても修正ありがとうございました。 ステップ実行してみましたが、毎回シートコピーのタイミングで強制終了していました。 Set ○○=Nothingをつける前はそのタイミングでオートメーションエラーが発生していました。 ＞とりあえず、こだわり無いならインデント付けたほうがいいとおもいます。 これからそうしようと思います。 ＞↓で複数ブックを選択可能にしてますが、提示されたコードだと複数選択されると困りませんか? ネットよりコピペでもってきていたので何をしているコードなのか理解していませんでした。 ＞ダメとはいいませんが、個人的にはActive○○に依存するコードは避けたほうがよいとおもいます。 これからそうします! ＞プロシージャを複数に分けてますが、何か目的あるんでしょうか? それぞれで動くかを見るために分けてました。 （chip） 2019/07/16(火) 03:19 ---- ■ ＞ネットよりコピペでもってきていたので何をしているコードなのか理解していませんでした 複数のファイルを選択させるつもりがないなら、 .AllowMultiSelect = True ←要らないとおもいます ■ 初期フォルダもカレントフォルダでよいということならば、Application.GetOpenFilenameという手もあります。（好みの問題でしょうけど） ■ いずれにせよ、対象が複数じゃないならループ処理はしないほうがよさそうです。 （ややこしくなるだけなので） Sub 複数選択不可() Const MyPath As String = "¥¥〇〇○" Dim buf As Variant Dim srcSH As Worksheet: Set srcSH = ActiveSheet Dim tmp As String '▼ダイアログを開いてユーザーにブックを選択させる（複数不可） buf = Application.GetOpenFilename("Excel ブック,*.xls?") '▼キャンセルが押される等でbufが初期値のままだったらプログラム終了 If buf = "" Then Exit Sub '▼ブックを開いて操作対象に With Workbooks.Open(buf) '▼シートをコピーしてユーザーに名前を入力してもらう srcSH.Copy After:=.Sheets(1) .Sheets(2).Name = InputBox("シート名入力") '▼（開いたブックの）拡張子を除いたブック名を取得 tmp = Left(.Name, InStrRev(.Name, ".") - 1) '▼（開いたブック）を名前を付けて保存して閉じる(同名ファイルがあっても強制上書き) Application.DisplayAlerts = False .SaveAs _ Filename:=MyPath & tmp, _ FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.DisplayAlerts = True .Close End With End Sub （もこな2） 2019/07/16(火) 04:17 ---- こちらで、できるだけ元のコードのままで、動くようにして 何度かテスト（同じブックにマクロシートを追加コピー）しましたが、固まる現象は 発生しませんでした マクロシートのセルD2には 適当に =COUNTA(G20:G29)+19 などと設定して動かしてみました。 もこな2さんのアドバイスのように、BeforeDoubleClickに変更して トラブルがでなくなったのなら 論理的に考えてSelectionChangeが悪さをしていたということになります。 もうコードは変更してしまったと思いますので、検証はできないと思いますが SelectionChangeのプロシージャの中に Msgbox Me.name などと記載して、予期しないイベントが発生していないかどうか確認するというのも デバック手法の一つです もう一つ気になるのが、マクロ登録プロシージャの起動方法です。 こちらでは、マクロ一覧のダイアログボックスから起動してテストしましたが ボタンからの起動などで、SelectionChange イベントが走ったりすると 固まるのかもしれません あとは、提示された以外の部分からの影響ですが、イベントを変えたら治ったということなので、 考えにくいかなと・・・ 最後に Dim ma As String ma = Range("D2")'入力されている最大行数をD2セルに関数算出してます。 です。 もこな2さんは 変数を省略していますが この宣言は文字列ですよ。 Range("D2")に29 などの数値が入力されていたとしたら maには"29" という文字列が代入されます VBAは親切なので、文字列を数値と比較しても、数値と解釈できるものであれば、読み替えてくれるので エラーにはならなかったと思いますが、 今後 変数の型などにも注意して 開発されることをお勧めします。 （渡辺ひかる） 2019/07/16(火) 09:33 ---- 渡辺ひかるさん ありがとうございます! Msgboxで確認する方法があったんですね、 今後このように確認しようとおもいます! Stringで宣言しておけば間違い無いと思ってました。 以後気をつけます。ありがとうございました! （chip） 2019/07/16(火) 10:37 ---- ＞この宣言は文字列ですよ。 本当だ。思いっきり見落としていました。フォローどもです。 ちなみに、「G19」以下ならどのセルでもということであれば、セルの値を使わずに↓でもよさそうです。 （ついでに、Cancel = Trueの位置を訂正） Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) With Target '▼処理対象か判定 If Intersect(Target, Range("G19", Cells(Rows.Count, "G"))) Is Nothing Then Exit Sub Cancel = True '▼Targetの値で条件分岐 Select Case .Value Case "" .Value = "P" .Font.Name = "Wingdings 2" .Offset(, 2).Value = Date Case "-" '何もしない Case Else .Value = "" .Offset(, 2).Value = "" End Select End With End Sub （もこな2） 2019/07/16(火) 14:37 ---- 質問者のコードには ma = Range("D2")'入力されている最大行数をD2セルに関数算出してます。 とありますので、最終行までではなく、データの最下行まで の制限があるのでは?と思います。 私は勝手に推測して >マクロシートのセルD2には 適当に =COUNTA(G20:G29)+19 などと設定して動かしてみました。 としています。 （渡辺ひかる） 2019/07/16(火) 15:04 ---- 渡辺ひかるさん、もこな2さん このシートはチェックシートの原紙です。 なので、19行目から70行目までにチェック項目を入力する欄が設けられていまして、 そこに文字が入るとD2セルの数字が増えていくようになっています。 ただ、今のままだと途中に空白行が出た場合に対応できなくなります。 Offsetでずらして判断しようかとおもいましたが、やり方がわかりませんでした。 （chip） 2019/07/16(火) 15:31 ---- スレを続けるかどうか微妙な質問ですが・・・ まずは現在の関数と データの入力状況を 説明してください 対応できている場合と、対応できなくなる場合と・・・・ （渡辺ひかる） 2019/07/16(火) 15:40 ---- 渡辺ひかるさん A19にIF(B19=“”,””,1) A20以降にIF(B20=“”,””,MAX($B$19:B19)+1)が入ってます。 D2はMAX(A19:A70)+18 B19以降の行はチェック項目です。 G19以降がチェック欄で、 I19以降が日付が入力される欄となります。 なんども申し訳ございません。 （chip） 2019/07/16(火) 15:53 ---- 数式はわかりました G列以降、I列以降 は今回の質問には無関係ですよね? B列についてMAX関数を使っているということは、B列の値がどのような状況なのかわからないと 何とも言えません。 >B19以降の行はチェック項目です。 とありますけどどのような値が入力されているのか? 単純な連番ですか? こちらで、指示通りの数式を登録してB列に適当に入力してみましたが B列への入力データの内容・ルールがわからないと、回答できないです。 >ただ、今のままだと途中に空白行が出た場合に対応できなくなります。 この事例も提供していただいていません。 質問者のそばで同じシートを見ているわけではないので、 きちんと説明してください （渡辺ひかる） 2019/07/16(火) 16:11 ---- 渡辺ひかるさん B19以降はは文字データが入力されます。 途中で空白行の件ですが、 B19に文字データが入りA19は1 B20は空白でA20は空白 B21に文字データが入りA20は2となり D2の結果は20となります。 この時にD20をダブルクリックするとチェックが入ってしまいます。 本当は、D21にチェックが入って欲しく、D20にはチェックが入らないようにしたいです。 （chip） 2019/07/16(火) 16:22 ---- ですからどんな文字データが入っているのでしょう? 常識的に考えて文字データというのは、あいう ABC などになると思いますが、間違っていますか? 文字データが入っているセルに対して、MAX($B$19:B19) という数値を対象とした関数を使うこと自体が おかしいと思いますが・・・ 例えば 新規シートのA1からA10 に 文字データ "AAA1","AAA2"・・・・・"AAA10" と入力して B1に =MAX(A1:A10) としても 0が返るだけですよね? 質問者さんが書いていることはそういうことですよ? >この時にD20をダブルクリックするとチェックが入ってしまいます。 >本当は、D21にチェックが入って欲しく、D20にはチェックが入らないようにしたいです。 本当にコードを理解されていますか? ダブルクリックイベントのTarget には、ダブルクリックされたセルが代入されており そこに値とフォントをセットしているので、D2の値が範囲内であれば、同じように実行され 値とフォントがセットされるセルはD2の値には影響されません。 ダブルクリックしたセルと異なるセルにチェックが入るなどという仕様は、使う側としても戸惑うだけだと思いますけど・・ （渡辺ひかる） 2019/07/16(火) 16:41 ---- 渡辺ひかるさん A20にはIF(B20=“”,””,MAX($A$19:A19)+1)のまちがいでした。 >本当にコードを理解されていますか? 申し訳ございません。理解できていなかったです。 では、If Select Case.Offset(,-6).Value=“” Then Exit Sub みたいなことは可能なのでしょうか?手元にPCが無いため確認ができなく、、 （chip） 2019/07/16(火) 16:55 ---- 質問者さん 時間を置きましょう PCもない状況では、そちらの状況も正確に把握できませんし 誤った情報で考えるのも疲れます。 そちらの状況が整った段階で、スレッドをもう一度読み直して 回答者がどのような情報を求めているか把握して、的確に提供してください アドバイスはそれからです。 （渡辺ひかる） 2019/07/16(火) 17:40 ---- 渡辺ひかるさん ありがとうございました! 後は自分で試行錯誤しながらやってみます! （chip） 2019/07/16(火) 18:18 ---- 書き溜めている間に話が終わっちゃいましたが、書いたので投稿しておきます。 ■（渡辺ひかる） 2019/07/16(火) 15:04のレスとして。 ちょっと勘違いされる書き方だったかもしれません。 「ちなみに〜」以下は質問者さん向けに書いたものです。 元のコードで If Target.Value = "" Then となっていましたので、ブランクセルの場合でも処理するケースがあるのだと判断して、Cells(Rows.count,"G")End(xlup)だと処理したい範囲が取得できないな〜と思ったので【「G19」以下ならどのセルでも】と断って提示している次第です。 ちなみに、G列の対象セルが「""」ではなく、純粋なブランクセルだと「=COUNTA(G20:G29)+19」では正しく掴めないと思うので、歯抜けやブランクが無い別の列を見ているのだとおもいますが、レイアウトも数式も提示が無かったし、そこまで深掘りする必要もないと思った（めんどくさかったとも言う）のでG19〜G列最下行までにしてみたというのも理由の一つです。 ■chipさん向けレスとして コメントの内容から推察して A列は数式が入っちゃってるから最終行取得には使えなさそう D列も数式が入っちゃってるから最終行取得には使えなさそう G列はブランクセルかもしれないから最終行取得には使えなさそう ・ ・ って消去法で考えていくと ＞B19以降はは文字データが入力されます。 って仰っているので、対象範囲はG【列】かつ、19【行】目〜B列の最下セルから上方向に見てヒットする【行】ということで良さそうに思います。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) With Target '▼処理対象か判定 If Cells(Rows.Count, "B").End(xlpu).Row < 19 Then Exit Sub If Intersect(Target, Range("G19", Cells(Cells(Rows.Count, "B").End(xlpu).Row, "G"))) Is Nothing Then Exit Sub Cancel = True '▼Targetの値で条件分岐 Select Case .Value Case "" .Value = "P" .Font.Name = "Wingdings 2" .Offset(, 2).Value = Date Case "-" '何もしない Case Else .Value = "" .Offset(, 2).Value = "" End Select End With End Sub ただ、個人的にはお話を読んでいると、最終行以下のG列を触るような運用になってなさそうですし、わざわざ下限?を設定しなくてもよさそうにおもうので、2019/07/16(火) 14:37 に提示したコードのように、G19〜G1048576のどこでも という条件も検討するだけでもしてみてほしいなぁとおもいます。 （もこな2） 2019/07/16(火) 23:15 ---- もこな2さん ありがとうございます。 明日より仕事なのでその際試してみます。 G列の下限?上限?は自分の考えでそんなチェック項目はないだろうという考えで設定していました。 （chip） 2019/07/18(木) 00:47... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201907/20190715202938.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97034 documents and 608020 words.
訪問者：