0

私は、いくつかのグラフを含む多数のカバー シートと、背面にある多数のシートを含むワークブックを持っています。グラフ ページは、1 つのシート (「MasterFormat」) を何度もコピーして貼り付け、毎回いくつかのキー値を変更することによって作成されます。

マクロはもともと、かなり迅速にCopy Method of Worksheet Class failedエラーを発生させていました。最終的にhttp://support.microsoft.com/kb/210684から修正方法を見つけました。

問題は、更新されたバージョンで際限なく問題が発生したことです。ほとんどの場合、問題なく実行され続けますが、しばらくすると実際には何もコピーされません。嬉しい理由の 1 つは、更新されたロジックにいくつかSet x = y, if x is nothing thenの s が含まれていることです。これは (私が知る限り) エラーが抑制された状態でのみ機能するため、それを実行しました。しかしその反面、コピーは50枚で止まってしまい、何の説明もありません( on error goto 0.

退屈して停止するだけでなく、実際にすべてのシートをコピーするために何を修正する必要があるかを誰かが知っていますか?

コードは次のとおりです。

Sub GenerateSheets()
    Application.ScreenUpdating = False

    Dim oBook As Workbook

    On Error Resume Next
    Set oBook = Workbooks("SSReport.xls")

    If oBook Is Nothing Then
        Set oBook = Application.Workbooks.Open("SSReport.xls")
    End If
    On Error GoTo 0

    Dim i, j As Integer
    Dim SheetName As String
    Dim ws As Worksheet
    Const PairingCount = 63

    Dim Pairings(1 To PairingCount, 1 To 2) As String
    For i = 1 To PairingCount
        Pairings(i, 1) = oBook.Sheets("SSPairings").Rows(i + 1).Cells(1)
        Pairings(i, 2) = oBook.Sheets("SSPairings").Rows(i + 1).Cells(2)
    Next i

    For i = 1 To PairingCount

         If i Mod 5 = 0 Then
            oBook.Close SaveChanges:=True
            Set oBook = Nothing
            Set oBook = Application.Workbooks.Open("SSReport.xls")
         End If

        Application.ScreenUpdating = False
        j = oBook.Worksheets.Count
        SheetName = "P" & Pairings(i, 1) & Pairings(i, 2)
        On Error Resume Next
        Set ws = oBook.Sheets(SheetName)
        If ws Is Nothing Then
            On Error GoTo 0
            oBook.Sheets("MasterFormat").Copy After:=Sheets(j)
            oBook.Sheets("MasterFormat (2)").Name = SheetName
        End If
        oBook.Sheets(SheetName).Cells(1, 2) = Pairings(i, 1)
        oBook.Sheets(SheetName).Cells(1, 5) = Pairings(i, 2)
        oBook.Sheets(SheetName).Cells(1, 8) = "P"
    Next i

    Application.ScreenUpdating = True
End Sub

これは、上記でリンクした KB 記事の提案であるメタ ワークブックから実行されます。興味深いことに、Open workbookメインのワークブックが開いていない場合、実際には機能しないようです。

4

3 に答える 3

1

エラーはおそらく次の行が原因です。

oBook.Sheets("MasterFormat").Copy After:=Sheets(j)

はSheets(j)、コード モジュールが存在するワークブックを参照しますが、これは意図したワークブックではない可能性があります。

以下は私にとってはうまくいきます：

Sub GenerateSheets()
Dim oBook As Workbook
Dim i As Long
Dim j As Long
Dim SheetName As String
Dim ws As Worksheet
Const PairingCount = 63
Dim Pairings(1 To PairingCount, 1 To 2) As String

On Error Resume Next
Set oBook = Workbooks("SSReport.xls")
On Error GoTo 0
If oBook Is Nothing Then
    Set oBook = Application.Workbooks.Open("SSReport.xls")
End If

With oBook
    For i = 1 To PairingCount
        Pairings(i, 1) = .Sheets("SSPairings").Rows(i + 1).Cells(1)
        Pairings(i, 2) = .Sheets("SSPairings").Rows(i + 1).Cells(2)
    Next i

    For i = 1 To PairingCount
        If i Mod 5 = 0 Then
            '//Save in case of corruption/error?'
            .Save
        End If

        j = .Worksheets.Count

        SheetName = "P" & Pairings(i, 1) & Pairings(i, 2)

        On Error Resume Next
        Set ws = .Sheets(SheetName)
        On Error GoTo 0
        If ws Is Nothing Then
            .Sheets("MasterFormat").Copy After:=.Sheets(j)
            .Sheets("MasterFormat (2)").Name = SheetName
        End If

        .Sheets(SheetName).Cells(1, 2) = Pairings(i, 1)
        .Sheets(SheetName).Cells(1, 5) = Pairings(i, 2)
        .Sheets(SheetName).Cells(1, 8) = "P"
    Next i
End With
End Sub

Saveこれは同じ結果を達成するはずなので、閉じる/再開を単純なものに置き換える自由を取りましたか?

于 2009-05-05T09:57:58.317 に答える
0

変更してみてください

        If ws Is Nothing Then
            On Error GoTo 0
            oBook.Sheets("MasterFormat").Copy After:=Sheets(j)
            oBook.Sheets("MasterFormat (2)").Name = SheetName
        End If
        oBook.Sheets(SheetName).Cells(1, 2) = Pairings(i, 1)
        oBook.Sheets(SheetName).Cells(1, 5) = Pairings(i, 2)
        oBook.Sheets(SheetName).Cells(1, 8) = "P"

の中へ 

     If ws Is Nothing Then
        On Error GoTo 0
        oBook.Sheets("MasterFormat").Copy After:=Sheets(j)
        oBook.Sheets("MasterFormat (2)").Name = SheetName
    else
       oBook.Sheets(SheetName).Cells(1, 2) = Pairings(i, 1)
       oBook.Sheets(SheetName).Cells(1, 5) = Pairings(i, 2)
       oBook.Sheets(SheetName).Cells(1, 8) = "P"
    End If

wsが何もない場合は、次の3行でスタックしていると思います。

于 2009-05-05T15:42:32.963 に答える
0

Lunatik の回答に基づいて、問題を解決したように見えるに変更oBook.Sheets("MasterFormat").Copy After:=Sheets(j)しました。oBook.Sheets("MasterFormat").Copy After:=oBook.Sheets(j)

于 2009-05-12T03:45:58.493 に答える