『マクロでコピー・他ブックの操作』（TTC） またご質問させてください。 いろいろやってみたのですがうまくいきません。 やりたいことは、開いたブックの標準モジュールに以下のコードが 記してあります。 まず開いたブックをそのまま別の名前に変えてコピーをとります。（決まったフォルダへ） コピーをとったら元のブックの各シートに入力されている数値を白紙にしてそのまま 保存します。 　 次に"別のエクセルファイル"を開いてそのうち１つのシートだけコピー保存し 元の白紙のシートを入力用にやはりコピーし、名前を変更します。 その別のファイルもそのまま保存します。 うまくいかないというのは、最初のコピーしたブックを閉じるとマクロが止まって しまいます。（全部終了してしまいます。） あと保存して閉じた"別のエクセルファイル"を開こうとするとEXCELが原因でエラー となり、閉じてしまいます。その後は読み取り専用でしか開けません。 以下にコードを記します。とても分かりにくい質問だと思いますが。 コードの記述でおかしいところなどありましたらご指摘いただきたいと 思います。 　Sub 日報保存()　　　'新実績表の標準モジュール 'Application.ScreenUpdating = False 'Application.WindowState = xlMaximized '最大化処理 'Application.Visible = False 'エクセルを見せない 'UserForm2.Show vbModeless 'Application.Wait Now() + TimeValue("00:00:02") '2秒後に開始合図 'MsgBox "開始します..." nenn = Format(Now, "yyyy") tuki = Sheets("入力").Range("C2").Value Hozoname = "実績表_" & nenn & "_" & tuki Hozon2 = "個人別_" & nenn & "_" & tuki Application.DisplayAlerts = False ChDir "D:\日報保存\過去日報素" ActiveWorkbook.SaveAs Filename:="D:\日報保存\過去日報素\" & Hozoname & ".xls", FileFormat _ :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _ False, CreateBackup:=False Workbooks.Open Filename:="C:\windows\ﾃﾞｽｸﾄｯﾌﾟ\新実績表.xls" Workbooks("新実績表.xls").Activate Sheets("入力").Select Range("C6:M33").Select Selection.ClearContents Sheets(Array("シート１", "シート２", "シート３", "シート４", "シート５", "シー ト６", "シート８")).Select Sheets("シート１").Activate Range("C4:AG27").Select Selection.ClearContents Range("C29:AG30").Select Selection.ClearContents Sheets("表").Select Range("C4:J31").Select Selection.ClearContents Range("L4:O31").Select Selection.ClearContents Range("S4:S31").Select Selection.ClearContents Sheets("入力").Activate Workbooks.Open Filename:="C:\windows\ﾃﾞｽｸﾄｯﾌﾟ\個人別売上2.xls" Workbooks("個人別売上2.xls").Activate Sheets("実績入力").Select With Sheets("実績入力") If .AutoFilterMode = True Then 'オートフィルターがONだったらOFF .AutoFilterMode = False End If End With Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Sheets("実績入力").Move 　Application.DisplayAlerts = False ChDir "D:\日報保存\過去日報素" ActiveWorkbook.SaveAs Filename:="D:\日報保存\過去日報素\" & Hozon2& ".xls",　 　　　FileFormat:=xlNormal _ , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False Windows("個人別売上2.xls").Activate Sheets("元表").Select Sheets("元表").Copy After:=Sheets("元表") Sheets("元表 (2)").Select Sheets("元表 (2)").Name = "実績入力" Workbooks("個人別売上2.xls").Save Workbooks("個人別売上2.xls").Close Unload UserForm2 MsgBox "(D:\日報保存\過去日報素)の中に" & "「" & Hozoname & "」" & _ "と" & vbCrLf & vbCrLf & "「" & Hozon2 & "」" & "を保存しました..." Application.ScreenUpdating = True Workbooks("新実績表.xls").Save Application.Visible = True 'エクセルを見せる Application.DisplayAlerts = False Workbooks(Hozoname).Close (Save) 'この場合ここで終了しました。 Workbooks(Hozon2).Close (Save) Application.Quit End Sub ---- 終了してしまう理由を理屈で考えて見ると… > ActiveWorkbook.SaveAs Filename:="D:\日報保存\過去日報素\" & Hozoname & ".xls" としている訳ですが、 この時点での「ActiveWorkbook」ってのは「最初に開いたブック」だと思うんですが、 「SaveAs」した時点で「Hozoname」になってるんですよね。 このマクロが動いているのは、すなわち「Hozoname」上であると。 だから > Workbooks(Hozoname).Close (Save) 'この場合ここで終了しました。 で終了してしまうのではないかしら。 （ご近所PG） ----- ご近所PGさん　ありがとうございます。 私も一行づつ見ていったらどうも「Hozoname」にマクロが 移っていて、最初のブックがなくなっていたようなので Workbooks.Open Filename:="C:\windows\ﾃﾞｽｸﾄｯﾌﾟ\新実績表.xls" を追加してみたのです... 「SaveAs」がいけないのでしょうか？ (TTC) ---- 根本的にマクロの記述がよくないですが、　 >別の名前に変えてコピーをとります。 これは、SaveCopyAs メソッドで出来ます。 よくないところ。 ・変数を宣言していない。 ・無駄な選択処理が多い。 Activate や Select は不要。 ・↑のために、ブックの指定やシートの指定を省略して、 アクティブなオブジェクトを対象にしている。 これらは改善しないと、確実な動作をするマクロにならないです。 あと、前半のコメントアウトされている部分も気になります。 ユーザーフォームの使い方など・・・（−−；）　 (INA) ----- INAさんありがとうございます。 最初がよくないうえに付け加えていった為、よく分からなくなってしまいました。 >これは、SaveCopyAs メソッドで出来ます。 これだと閉じる構文は必要はないのでしょうか？ 変数は名前につかうので「String」でよいのでしょうか？ >ユーザーフォームの使い方など・・・（−−；）　 間違ってますか？「しばらくお待ちください...」と でるようにしたかったので・・・。 (TTC) ----- >これは、SaveCopyAs メソッドで出来ます。 出来ました。シートだけの移動の場合はまた違うやり方ですか？ (TTC) ---- >シートだけの移動の場合はまた違うやり方ですか？ 意味がよく分かりません。 「シートの移動」ならマクロの記録で出来ると思いますが・・ 　　 >変数は名前につかうので「String」でよいのでしょうか？ よいです。 (INA) ---- INAさんありがとうございます。 基本的には変わってませんがもう一度見直して整えてみました（自分なりに） 通して作動させてみると最後に「アクセス違反...？」というメッセージで 終了されてしまいます。 順番が悪いのでしょうか？ブック等の指定が間違っているのでしょうか？ Sub 日報保存() Dim nenn As String Dim tuki As String Dim Hozoname As String Dim Hozon2 As String Application.ScreenUpdating = False Application.WindowState = xlMaximized '最大化処理 Application.Visible = False 'エクセルを見せない UserForm2.Show vbModeless Application.Wait Now() + TimeValue("00:00:02") '2秒後に開始合図 MsgBox "開始します..." nenn = Format(Now, "yyyy") tuki = Sheets("入力").Range("C2").Value Hozoname = "実績表_" & nenn & "_" & tuki Hozon2 = "個人別_" & nenn & "_" & tuki Application.DisplayAlerts = False '画面更新しない ChDir "C:\日報保存\過去日報素"　　　　　　'新実績表を別の名前で保存 ActiveWorkbook.SaveCopyAs Filename:="C:\日報保存\過去日報素\" & Hozoname& ".xls" Sheets("入力").Select　　　　　　　　　'新実績表の記入してあるセルをクリア Range("C6:M33").Select Selection.ClearContents Sheets(Array("1", "2", "3", "4", "5", "6", "7")).Select Range("C4:AG27").Select Selection.ClearContents Range("C29:AG30").Select Selection.ClearContents Sheets("表").Select Range("C4:J31").Select Selection.ClearContents Range("L4:O31").Select Selection.ClearContents Range("S4:S31").Select Selection.ClearContents Sheets("入力").Activate '個人別売上2を開く Workbooks.Open Filename:="C:\windows\ﾃﾞｽｸﾄｯﾌﾟ\個人別売上2.xls" With Sheets("実績入力")　　　　'実績入力シートを選択 If .AutoFilterMode = True Then 'オートフィルターがONだったらOFF .AutoFilterMode = False End If End With ActiveSheet.Cells.Select　　'まずリンクを外す為に値だけにします 　　Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Sheets("実績入力").Move　　　'実績入力シートを移動し別名で保存 Application.DisplayAlerts = False ChDir "C:\日報保存\過去日報素" ActiveWorkbook.SaveAs Filename:="C:\日報保存\過去日報素\" & Hozon2 & ".xls" Windows(Hozon2).Close　　　　　　'閉じます Sheets("元表").Copy After:=Sheets("元表")　'入力シートは移動されたので 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　元表をコピーします Sheets("元表 (2)").Name = "実績入力" 'Selection.Name = "実績入力" ActiveWorkbook.Save　　　　　　　　'保存し閉じます Workbooks("個人別売上2").Close Unload UserForm2 MsgBox "(C:\日報保存\過去日報素)の中に" & "「" & Hozoname & "」" & _ "と" & vbCrLf & vbCrLf & "「" & Hozon2 & "」" & "を保存しました..." Application.ScreenUpdating = True Workbooks("新実績表.xls").Save　　　　　　'保存し終了 Application.Visible = True 'エクセルを見せる Application.DisplayAlerts = False Application.Quit End Sub ----- まず状況と仕様を教えてもらえますか？ >アクセス違反...？」というメッセージで 終了されてしまいます。 どの行で発生しますか？　F8 キーでステップ実行してみて下さい。 >UserForm2.Show これは何のためですか？ > Application.Wait これは何のためですか？ >Application.Visible = False >Application.ScreenUpdating = True 完全に動作するまで、使用しない方が良いです。 >Application.DisplayAlerts = False True に戻さないといけません。 >Application.Quit　 他にブックを開いて作業している人には、不便ですよ？ > Workbooks("個人別売上2").Close .xls が抜けています。 (INA) ---- ざっとですが、修正してみました。 (INA) Sub 日報保存改() Dim nenn As String Dim tuki As String Dim Hozoname As String Dim Hozon2 As String Dim wb As Workbook 'Application.ScreenUpdating = False Application.WindowState = xlMaximized '最大化処理 Application.Visible = False 'エクセルを見せない Application.DisplayAlerts = False ' UserForm2.Show vbModeless ' Application.Wait Now() + TimeValue("00:00:02") '2秒後に開始合図 ' MsgBox "開始します..." With ThisWorkbook nenn = Format(Now, "yyyy") tuki = .Worksheets("入力").Range("C2").Value Hozoname = "実績表_" & nenn & "_" & tuki Hozon2 = "個人別_" & nenn & "_" & tuki '新実績表を別の名前で保存 .SaveCopyAs Filename:="C:\日報保存\過去日報素\" & Hozoname & ".xls" '新実績表の記入してあるセルをクリア .Worksheets("入力").Range("C6:M33").ClearContents .Worksheets(Array("1", "2", "3", "4", "5", "6", "7")).Range("C4:AG27").ClearContents .Worksheets(Array("1", "2", "3", "4", "5", "6", "7")).Range("C29:AG30").ClearContents With .Worksheets("表") .Range("C4:J31").ClearContents .Range("L4:O31").ClearContents .Range("S4:S31").ClearContents End With .Sheets("入力").Activate End With '個人別売上2を開く Set wb = Workbooks.Open("C:\windows\ﾃﾞｽｸﾄｯﾌﾟ\個人別売上2.xls") With wb With .Worksheets("実績入力") .AutoFilterMode = False 'オートフィルターOFF 'まずリンクを外す為に値だけにします .Cells.Copy .Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False '実績入力シートを移動し別名で保存 .Move End With ActiveWorkbook.SaveAs Filename:="C:\日報保存\過去日報素\" & Hozon2 & ".xls" ActiveWorkbook.Close '入力シートは移動されたので元表をコピーします .Worksheets("元表").Copy After:=.Worksheets("元表") .Worksheets("元表 (2)").Name = "実績入力" '保存して閉じる .Close True End With 'Unload UserForm2 MsgBox "(C:\日報保存\過去日報素)の中に「" & Hozoname _ & "」と" & vbCrLf & vbCrLf & "「" & Hozon2 & "」を保存しました..." 'マクロブックを保存し終了 ThisWorkbook.Close True Application.Visible = True 'エクセルを見せる Application.DisplayAlerts = True Application.ScreenUpdating = True 'Application.Quit End Sub ----- お返事おそくなりました。 >アクセス違反...？」というメッセージで 終了されてしまいます。 >どの行で発生しますか？　F8 キーでステップ実行してみて下さい。 Workbooks("新実績表.xls").Save　'保存し終了 で発生しました。 >UserForm2.Show >これは何のためですか？ ラベルで「しばらくおまちください...」と貼ってあります。 この作業は月１回の作業ですが他に毎日の作業があって、その長い動作を プログレスバーで表したかったのでそれに合わせました。ただそれほど 長い動作ではなかったのでただのユーザーフォームにしたのです。 > Application.Wait >これは何のためですか？ MsgBoxを表示させないでやるとラベルが見えないまま終わってしまったので ラベルを表示させるためにMsgBoxを出しました。２秒は見た感覚で、すぐだと 何か変だったのでそうしました作業の上で意味はありません。 他の人に使ってもらうものなので...。 >Application.Visible = False >Application.ScreenUpdating = True >完全に動作するまで、使用しない方が良いです。 >Application.DisplayAlerts = False >True に戻さないといけません。 知りませんでした... >Application.Quit　 >他にブックを開いて作業している人には、不便ですよ？ 関係ないブックまで終わってしまうんですね...エクセルの 終了をさせたかったのですが... > Workbooks("個人別売上2").Close >.xls が抜けています。 INAさん、ご指摘ありがとうございます。 直していただいたコードでやってみます。 (TTC) ---- ユーザーフォームをモーダルで表示して、 処理のコードを、ユーザーフォームモジュールの activate イベントから Call したほうがスマートになりますよ。 そうすれば wait や msgbox も必要なくなると思います。 (INA) ----- 現在シートのコマンドボタンから Call させていますが... コマンドボタンクリックから UserForm2.Show vbModal として Private Sub UserForm_activate() Call 日報保存 でよろしいんでしょうか？ あと修正していただいたところで、 .Worksheets(Array("1", "2", "3", "4", "5", "6", "7")).Range("C4:AG27").ClearContents のところで オブジェクトはこの・・・をサポートしていません・・・ と、実行時エラーになってしまします。 (TTC) ---- >実行時エラーになってしまします。 失礼しました。 ここは、Select しないとダメなようなので以下のように修正して下さい。 >.Worksheets(Array("1", "2", "3", "4", "5", "6", "7")).Range ("C4:AG27").ClearContents >.Worksheets(Array("1", "2", "3", "4", "5", "6", "7")).Range("C29:AG30").ClearContents　 ↓ Worksheets(Array("1", "2", "3", "4", "5", "6", "7")).Select Selection.Range("C4:AG27").ClearContents Selection.Range("C29:AG30").ClearContents > 現在シートのコマンドボタンから Call させていますが... >コマンドボタンクリックから UserForm2.Show vbModal として >Private Sub UserForm_activate() >Call 日報保存 でよろしいんでしょうか？ そうです。 (INA) ----- INAさん、ありがとうございます。 通して実行させると最後に「オートメーションエラー」 と出てきて終了されてしまいました。 １行づつ実行させると ThisWorkbook.Close True のところでエクセルが閉じてしまいます。 そしてやはり個人別売上2が開けなくなってしまいました。 何が原因でしょうか... それとユーザーフォームですが教えていただいた方法でやってみましたが ラベルが表示されず（ユーザーフォームが白くなってしまう）文字が 見えませんでした。 (TTC) ---- またまた失礼しました。 マクロブックを閉じると、そこでマクロが終了してしまうので、 Closeは最後にしてください。 ↓ Application.Visible = True 'エクセルを見せる Application.DisplayAlerts = True Application.ScreenUpdating = True 'マクロブックを保存し終了 ThisWorkbook.Close True End Sub >それとユーザーフォームですが教えていただいた方法でやってみましたが >ラベルが表示されず（ユーザーフォームが白くなってしまう）文字が 見えませんでした。 　 Private Sub UserForm_activate() Me.Repaint Call 日報保存 としてみてください。 (INA) ----- ユーザー−フォームは表示されるようになりました。ありがとうございます。 表示される前に処理が始まってしまうという意味だったのでしょうか？ 「Me.Repaint」表示しなおし？のような意味ですか？ 処理ですが、「オートメーションエラー」は出てきてしまいました。 ステップインだと ThisWorkbook.Close True で閉じるのですが 内側のウインドウだけ閉じるというか...外側は残ってしまうようです。 最後の End Sub まで行っていないようなのですがその辺はよいのでしょうか？ (TTC) ----- > 「Me.Repaint」表示しなおし？のような意味ですか？ 　 VBAのヘルプで、Repaint メソッドのページを読んでみて下さい。 「 フォームまたはページを描画し直すことによって、その表示内容を更新します。」 >ステップインだと ThisWorkbook.Close True で閉じるのですが >内側のウインドウだけ閉じるというか...外側は残ってしまうようです。 quit していないので、 Excelアプリケーションは終了していません。 ブックだけ終了しているので、動作は正しいです。 >最後の End Sub まで行っていないようなのですがその辺はよいのでしょうか？ マクロブックを Close した時点で終了なので、あっています。 > 処理ですが、「オートメーションエラー」は出てきてしまいました。 やっかいな問題は、↑ですね。 処理のフローを検討しないといけなさそうです。 念のため、以下のように１行追加しておいて下さい。 > '保存して閉じる > .Close True >End With ↓ '保存して閉じる .Close True Set wb = Nothing End With あと、保存処理を分けてみてください。 > 'マクロブックを保存し終了 > ThisWorkbook.Close True >End Sub 　　　　↓ 'マクロブックを保存し終了 ThisWorkbook.Save ThisWorkbook.Close End Sub (INA) ----- 何度も申し訳ございません。 やってみました。 オートメーションエラーは出てきてしまいました... MsgBox までは出るのでその後に何か問題があるのでしょうか？ そのあと 「wb」 を開いても「不正な処理云々・・・」とでて閉じます。 ちなみに「wb」の保存処理も分けてみましたが変わりませんでした。 （関係なかったのかもしれないですが...） (TTC)　 ----- さいごのメッセージボックスのところでは、 すでにユーザーフォームは閉じてありますよね？ (INA) ----- 再度確認しました。 メッセージボックスの時にはユーザーフォームは閉じています。 そしてエクセルが見えて保存中にエラーメッセージがでます。 (TTC) ---- > ThisWorkbook.Save の前に Exit Sub を入れて、マクロを終了させておいて、 手動で保存するとどうなりますか？ あと、 >Application.ScreenUpdating = False >Application.Visible = False これらをコメント化して、使わないで実行してみて下さい。　 (INA) ----- やってみました。 何故でしょう...手動で保存してもエラーになります。 EXCEL のページ違反です。 モジュール : VBE6.DLL、アドレス : 0177:6512be2d Registers: EAX=00000000 CS=0177 EIP=6512be2d EFLGS=00010202 EBX=00000000 SS=017f ESP=0062e8cc EBP=0062e8e4 ECX=00000001 DS=017f ESI=016a5924 FS=1a5f EDX=00000007 ES=017f EDI=00000000 GS=0000 Bytes at CS:EIP: 8b 08 ff 51 04 a1 e0 4f 22 65 39 78 7c 74 3b 8b Stack dump: ↑全く分からないのですがエラーメッセージ時の詳細です。 >Application.ScreenUpdating = False >Application.Visible = False >これらをコメント化して、使わないで実行してみて下さい。 そのとおりにしました。 (TTC) ----- 新規ブックを作って、シート名などをあわせて、 ユーザーフォームを使わずに 以下のマクロ を実行してみて下さい。 Sub 日報保存改2() Dim nenn As String Dim tuki As String Dim Hozoname As String Dim Hozon2 As String Dim wb As Workbook Application.DisplayAlerts = False With ThisWorkbook nenn = Format(Now, "yyyy") tuki = .Worksheets("入力").Range("C2").Value Hozoname = "実績表_" & nenn & "_" & tuki Hozon2 = "個人別_" & nenn & "_" & tuki '新実績表を別の名前で保存 .SaveCopyAs Filename:="C:\日報保存\過去日報素\" & Hozoname & ".xls" '新実績表の記入してあるセルをクリア .Worksheets("入力").Range("C6:M33").ClearContents Worksheets(Array("1", "2", "3", "4", "5", "6", "7")).Select Selection.Range("C4:AG27").ClearContents Selection.Range("C29:AG30").ClearContents With .Worksheets("表") .Range("C4:J31").ClearContents .Range("L4:O31").ClearContents .Range("S4:S31").ClearContents End With .Sheets("入力").Activate End With '個人別売上2を開く Set wb = Workbooks.Open("C:\windows\ﾃﾞｽｸﾄｯﾌﾟ\個人別売上2.xls") With wb With .Worksheets("実績入力") .AutoFilterMode = False 'オートフィルターOFF 'まずリンクを外す為に値だけにします .Cells.Copy .Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False '実績入力シートを移動し別名で保存 .Move End With ActiveWorkbook.SaveAs Filename:="C:\日報保存\過去日報素\" & Hozon2 & ".xls" ActiveWorkbook.Close '入力シートは移動されたので元表をコピーします .Worksheets("元表").Copy After:=.Worksheets("元表") .Worksheets("元表 (2)").Name = "実績入力" '保存して閉じる .Close True Set wb = Nothing End With MsgBox "(C:\日報保存\過去日報素)の中に「" & Hozoname _ & "」と" & vbCrLf & vbCrLf & "「" & Hozon2 & "」を保存しました..." Application.DisplayAlerts = True 'マクロブックを保存し終了 ThisWorkbook.Save ThisWorkbook.Close End Sub (INA)　　　 ------ 新規ブックを作り↑のマクロを動かしてみました。 普通に最後まで実行されましたが wb のほうが不正・・・ で開けなくなったので wb のほうも新規ブックにして シート名だけあわせたら問題ありませんでした。 なにやら変なアイコンができてしまいます。 もう一度、旧の方を動かしたらﾃﾞｽｸﾄｯﾌﾟのアイコンが 消えてしまいました。 マクロではなくエクセルのブックが悪いのでしょうか？ もう一度 wb のほうのブックを作り直してやってみます。 (TTC) ---- マクロをずーっといじって編集を繰り返していると、 ブックがおかしくなって破損することがあります。 そのようなときはひとまず、新規ブックにデータをコピーで移して、 ファイルを作り直すのがよいです。 VBE6.DLLのエラーだと、Visual Basic Editorの割り当てメモリが不足して 処理しきれなくなってエラーが発生することがあります。 マクロコードに、おもいあたるような記述がないときは、 tempフォルダを削除したり、ブックを作り直すのがよいでしょう。 マクロウィルスのようなものを作っていると発生しやすい・・かな。 (INA) ----- ファイルを作り直しました。 正常に作動しエラーはでなくなりましたが、 wb（個人別） が開けなくなってしまいます。 エクセルが原因でEXCEL.EXEにエラーが・・・ というメッセージのあと閉じられてしまいます。 その後は読み取り専用でも開けません。 手動でシートを移動し、元表をコピーし名前を変更し 上書き保存して閉じる事を試みましたがその場合は 問題ありませんでした。 どのようなことが考えられるでしょうか... (TTC) ---- 確認です。　 実行したのでは、 Sub 日報保存改2()　ですよね？ OSとExcelのバージョンは何でしょうか？ ファイルが正常に保存されずに、破損している感じでしょうか？ 詳しい原因は分かりませんが、処理方法を見直してみます。 (INA) ----- もう一度ファイルを作り直しました。 テーブル等設定してあったのですが 全部作り直しましたら問題なく作動しました。 今の会社のPCはWinMeで2000ですが昨日自宅ではWin98の2000でした。 Sub 日報保存改2()　だけだと問題なく処理されました。 ありがとうございました。 コマンドボタンからだとオートメーションエラーになります。 ユーザーフォーム等が悪いのでしょうか？ (TTC) ----- > ユーザーフォーム等が悪いのでしょうか？　 Application.Visible = False を使わないとどうでしょうか？ Select を使っているので、非表示にするのがまずいのだと思うのですが・・ 非表示にせずに、最小化にしておいては？ 　↓ Application.WindowState = xlMinimized (INA) ----- 大変遅くなり申し訳御座いません。手がつけられませんでした... Application.Visible = False を使わないで実行させてみました。 Application.DisplayAlerts = False　だけにして ユーザーフォームを表示させるようにしましたが エラーになってしまいました。 フォームファイルが壊れることはありえますでしょうか？ 　明日もういちどフォームを作り直してやってみようと思いますが、 だめなようならINAさんに提示いただいた最小化にしとこうかと 思います...他は問題なく作動しておりますので。 一点、上記のコードではクリアされなかったので Worksheets(Array("1", "2", "3", "4", "5", "6", "7")).Select Selection.Range("C4:AG27").ClearContents Selection.Range("C29:AG30").ClearContents にしてみたら空白になったので変えました。問題ないですよね？ (TTC) ---- > Worksheets(Array("1", "2", "3", "4", "5", "6", "7")).Select . が抜けてました。すみません。 ↓ .Worksheets(Array("1", "2", "3", "4", "5", "6", "7")).Select >フォームファイルが壊れることはありえますでしょうか？ あまりないと思います。 壊れるならブックごとが多いと思います。 > Application.Visible = False を使わないで実行させてみました。 >Application.DisplayAlerts = False　だけにして >ユーザーフォームを表示させるようにしましたが >エラーになってしまいました。 手強いなぁ・・・ 直接、不具合環境でコーディング出来れば、 ３０分くらいで対処できそうなんですけどねぇ・・ コードを掲載するとスレッドが長くなるので、ファイルに書きました。 こんな感じで試して頂けますか？ http://camaro.ddo.jp/books/TTC.xls (INA) ------ INAさん作り直していただいてありがとうございます。 そのまま試してみました。 処理コードだけは問題ありませんでしたが、 コマンドボタンクリックで行なうと最小化したまま点滅したまま になってしまったので、そこをクリックするとユーザーフォームが 出てきます。がそのままエラーになってしまいました。 どの部分かは分かりませんでした。 (TTC) ---- 少しなおしたので、再度ダウンロードして試してみて下さい。 (INA) ----- 再度試しました。ユーザーフォームは出るようになりました。 メッセージボックスまで出ますが、最後保存してると思われるときに エラーになってしまいました。 (TTC) ---- 何エラーですか？　保存されたファイルに異常はありますか？ (INA) ----- すいません。 「不正な処理を行ったため強制終了します。」 詳細はVBE6.DLLのエラーでした。 保存した「個人別売上2」は問題ありませんでした。 Hozoname,Hozon2 も以上有りません。 本体というかコードの入っているブックだけ開けなくなります。 プログラムの強制終了でEXCELを終了させるかコンピューターを 再起動させればまた開くことが出来ますが保存はされてません。 (TTC) ----- ユーザーフォームモジュールで実行するマクロを 以下のように置き換えて試してみて下さい。 以下の処理で問題なければ、日報保存改3マクロに原因があることになります。　 Private Sub UserForm_Activate() Dim i As Long For i = 1 To 1000 Me.Repaint DoEvents Label1.Caption = i Next i '↑の処理にする。 ' Call 日報保存改3 '←コメント化 Unload Me End Sub (INA) ------ 置き換えて試しました。 問題なくユーザーフォームも出現し終了しました。 その後もファイルに問題はありません。 (TTC) ---- Sub 日報保存改3() ↓ Sub 日報保存改4() に変更しましたので、再度ダウンロードして試してみて下さい。 (INA) ------ すみません。同じところで同じエラーになってしまいました。 保存中です。 (TTC) ---- Excel や Windows は update してありますか？ ほかのパソコンで試すことはできませんか？ (INA) ----- 遅くなりました。 今まで4台のパソコンで(windows Me,NT,98)試してみました。 結果は同じでした。ただoffice等は会社で用意されたものなので、 同じだと思います。 updateに関してですが、自分が使ってるパソコンはしていませんでした。 officeのupdate等を行なって試してみます。 windoesのupdateは先ほどマイクロソフトのページで見てみたのですが 全部行った方が良いのでしょうか？（ほとんどがセキュリッティーに関してでしたが） (TTC) ----- 直りました！ よくわからないのですが、 office の update をしてもだめだったのですが、 開いたエクセルファイルのツール？のところに 「〜の修復をする」という項目が出てることに気づいたので 実行してみたらその後、エラーなど出ずに終了するようになりました。 Sub 日報保存改3()　でもためしてみましたが出来ました。 今までは修復の項目などなかったのですが... 修復後ももうなくなっていました。 update が原因なのでしょうか？ 時間をかけてしまって申し訳ございませんでした。 このまま問題なければ、Sub 日報保存改3()　の方を 使おうと思っているのですが...（保存後の見た目で) 3でも問題ないでしょうか？ (TTC) ---- 問題ないです。 (INA) ----- ありがとうございました。 (TTC)