Excel VBAが突然マクロランタイム中にデザインモードに移行する

Question

誰かがこの問題を助けてくれることを願っています。

私は、このワークブックのデータを別の既存のワークブック（レポートワークブック）にコピーするサブルーチンを用意しています。

コードを実行しようとすると、ランタイム中にレポートワークブックが開くと、突然停止し、デザインモードに移行することがわかりました。したがって、ルーチンの実行を妨げる。

しかし、私はサブルーチンにブレークポイントを入れて、それをもう一度やり直そうとします。問題なく実行されます。これはちょっと奇妙なようです。

私はこれを理解しようとしています。

これまでのところ私が試したトラブルシューティングの手順です。

1. 別のマシンでブックを実行しようとしました。
2. レポートワークブックですべてのWorkbook_Openを削除しようとしました。
3. レポートブックのすべてのマクロコードを削除しようとしました。
4. エラーハンドラを挿入します。残念ながら、エラーは表示されません。
5. サブルーチンでDoEventsコードを削除しようとしました。

まだ運がありません。コードの実行を停止します。

Private Sub TransferRawData() 
Dim wsPTRawData As Worksheet, wbPTWorkBook As Workbook, wsOutputRaw As Worksheet 
Dim filePath As String, FileName As String, ptTargetRow As Long 

Application.EnableEvents = False 
Application.StatusBar = "Exporting All Raw Data... Please wait a moment..." 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

filePath = ThisWorkbook.Path & "\" 
FileName = filePath & pt_FileName 

Set wbPTWorkBook = Workbooks.Open(FileName:=FileName, UpdateLinks:=0, IgnoreReadOnlyRecommended:=True) 
DoEvents 
Set wsPTRawData = wbPTWorkBook.Worksheets(pt_ProdRawSheet) 
Set wsOutputRaw = ThisWorkbook.Sheets(merger_prodOutputSheet) 

ptTargetRow = wsPTRawData.Range("A" & Rows.Count).End(xlUp).Row + 1 

If lastRow(wsOutputRaw, "A") > 1 Then wsOutputRaw.Range("A2:F" & lastRow(wsOutputRaw, "A")).Copy wsPTRawData.Range("A" & ptTargetRow) 

wbPTWorkBook.Close True 

Set wsOutputRaw = Nothing 
Set wsPTRawData = Nothing 
Set wbPTWorkBook = Nothing 

End Sub 

私は上記のコードを使用するワークブックを3セット持っています。それらのすべてがレポートワークブックにデータをコピーします。しかし、彼らはすべて転送ルーチンの実行に問題があります。

詳細については、ルーチンを実行すると、Workbooks.Openイベントが実行されます。 VBAプロジェクトウィンドウとExcelウィンドウのスクリーンショットです。

Answer 1

こんにちはこの問題が今後発生します。

コード自体はエラーとは関係ありません。

このエラーを調査するのに多くの時間がかかりました。私は、犯人が私がマクロ自体に割り当てたショートカットキーであることを知りました。

私はを割り当てました。CTRL + SHIFTマクロをキー入力すると、他のブックの他のマクロが開かれるのが妨げられます。

私はマクロショートカットキーで設定を行い、Shiftキーを避けました。その結果、サブルーチンはそれがする必要があることを行います。

Answer 2

ここでエラーハンドラを追加し、適切

Private Sub TransferRawData() 
Dim wsPTRawData As Worksheet, wbPTWorkBook As Workbook, wsOutputRaw As Worksheet 
Dim filePath As String, FileName As String, ptTargetRow As Long 

Application.EnableEvents = False 
Application.StatusBar = "Exporting All Raw Data... Please wait a moment..." 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

filePath = ThisWorkbook.Path & "\" 
FileName = filePath & pt_FileName 

On Error GoTo ErrHandler 
Set wbPTWorkBook = Workbooks.Open(FileName:=FileName, UpdateLinks:=0, IgnoreReadOnlyRecommended:=True) 
DoEvents 
Set wsPTRawData = wbPTWorkBook.Worksheets(pt_ProdRawSheet) 
Set wsOutputRaw = ThisWorkbook.Sheets(merger_prodOutputSheet) 

ptTargetRow = wsPTRawData.Range("A" & Rows.Count).End(xlUp).Row + 1 

If lastRow(wsOutputRaw, "A") > 1 Then wsOutputRaw.Range("A2:F" & lastRow(wsOutputRaw, "A")).Copy wsPTRawData.Range("A" & ptTargetRow) 

wbPTWorkBook.Close True 

Set wsOutputRaw = Nothing 
Set wsPTRawData = Nothing 
Set wbPTWorkBook = Nothing 


ErrHandlerSave: 
    Debug.Print Chr(13) & "Error # " & Str(Err.Number) & " was generated on Saving" _ 
     & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description 
End Sub 

をキャッチされていないエラーがある場合は、でImmediateウィンドウに出てくるエラーメッセージが表示されます見ますVBAコードの最後。あなたがそれを持っていないか、それを表示する方法がわからない場合LOOK HERE