7

約 500 の Excel ファイルにシートを追加する VBA スクリプトがあります。VBA スクリプトの実行と単純なシートの追加には問題はありませんでしたが、VBA スクリプトとグラフとボタンを含むシートを追加しようとすると、しばらく動作してからフリーズします。

これがコードです。エラー処理がないことはわかっています-この問題に取り組む方法や、Excelがフリーズする原因は何ですか?

Sub FindOpenFiles()

Const ForReading = 1
Set oFSO = New FileSystemObject

Dim txtStream As TextStream

Dim FSO As Scripting.FileSystemObject, folder As Scripting.folder, file As Scripting.file, wb As Workbook, sh As Worksheet
Dim directory As String

'The path for the equipement list. - add the desired path for all equipement or desired value stream only.
Set txtStream = oFSO.OpenTextFile("O:\SiteServices\Maintenance\Maintenance Support Folder\Maintenance Department Information\HTML for Knowledgebase\Excel for Knowledgebase\Equipement paths-all.txt", ForReading)

Do Until txtStream.AtEndOfStream
    strNextLine = txtStream.ReadLine
    If strNextLine <> "" Then

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder = FSO.GetFolder(strNextLine)


    For Each file In folder.Files
        If Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xls" Then
            Workbooks.Open strNextLine & Application.PathSeparator & file.Name

        Set wb = Workbooks("Equipment Further Documentation List.xls")
    For Each sh In Workbooks("Master File.xls").Worksheets
        sh.Copy After:=wb.Sheets(wb.Sheets.Count)
    Next sh

     ActiveWorkbook.Close SaveChanges:=True
     ActiveWorkbook.CheckCompatibility = False

        End If


    Next file
    End If

    Loop
txtStream.Close

End Sub
4

2 に答える 2

9

私はついに私の問題を解決しました...

解決策は、次のコード行を追加することでした。

Application.Wait (Now + TimeValue("0:00:01"))

行の後:

sh.Copy After:=wb.Sheets(wb.Sheets.Count)

これにより、シートを新しい Excel ファイルにコピーする時間ができました。

これまでのところ、それは魅力のように機能しています。

この問題で私を助けてくれたすべての人に感謝したい.

どうもありがとう。

于 2013-08-12T11:26:25.413 に答える