[[20040922165138]] 『マクロでコピー・他ブックの操作』(TTC) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『マクロでコピー・他ブックの操作』(TTC)

 またご質問させてください。
 いろいろやってみたのですがうまくいきません。
 やりたいことは、開いたブックの標準モジュールに以下のコードが
 記してあります。
 まず開いたブックをそのまま別の名前に変えてコピーをとります。(決まったフォルダへ)

 コピーをとったら元のブックの各シートに入力されている数値を白紙にしてそのまま
 保存します。
 
 次に"別のエクセルファイル"を開いてそのうち1つのシートだけコピー保存し
 元の白紙のシートを入力用にやはりコピーし、名前を変更します。
 その別のファイルもそのまま保存します。

 うまくいかないというのは、最初のコピーしたブックを閉じるとマクロが止まって
 しまいます。(全部終了してしまいます。)

 あと保存して閉じた"別のエクセルファイル"を開こうとすると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("シート1", "シート2", "シート3", "シート4", "シート5", "シー ト6", "シート8")).Select
     Sheets("シート1").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
 >これは何のためですか? 
 ラベルで「しばらくおまちください...」と貼ってあります。
 この作業は月1回の作業ですが他に毎日の作業があって、その長い動作を
 プログレスバーで表したかったのでそれに合わせました。ただそれほど
 長い動作ではなかったのでただのユーザーフォームにしたのです。

 > Application.Wait 
 >これは何のためですか? 
 MsgBoxを表示させないでやるとラベルが見えないまま終わってしまったので
 ラベルを表示させるためにMsgBoxを出しました。2秒は見た感覚で、すぐだと
 何か変だったのでそうしました作業の上で意味はありません。
 他の人に使ってもらうものなので...。

 >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さん、ありがとうございます。
 通して実行させると最後に「オートメーションエラー」
 と出てきて終了されてしまいました。
 1行づつ実行させると
 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 した時点で終了なので、あっています。

 > 処理ですが、「オートメーションエラー」は出てきてしまいました。
 やっかいな問題は、↑ですね。

 処理のフローを検討しないといけなさそうです。

 念のため、以下のように1行追加しておいて下さい。

 >  '保存して閉じる
 >    .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 だけにして
 >ユーザーフォームを表示させるようにしましたが
 >エラーになってしまいました。
 手強いなぁ・・・
 直接、不具合環境でコーディング出来れば、
 30分くらいで対処できそうなんですけどねぇ・・

 コードを掲載するとスレッドが長くなるので、ファイルに書きました。
 こんな感じで試して頂けますか?
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)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.