1

我正在使用 excel 2007。我正在使用一个宏，它将所有可见工作表复制到新工作簿并保存为文本文件。我有超过 12 张纸，我必须从中复印至少 10 张纸。4 个可见工作表是副本，但在第五个工作表上我收到了 Application_defined 或 Object_defined 错误。我有其他六张表。请帮我解决这个问题。 

Sub day_end_process()

'Working in 97-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim FolderName As String

'Copy every sheet from the workbook with this macro
Set Sourcewb = ThisWorkbook

'Create new folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = Sourcewb.path & "\" & Sourcewb.Name & " " & DateString
MkDir FolderName

'Copy every visible sheet to a new workbook
For Each sh In Sourcewb.Worksheets

    'If the sheet is visible then copy it to a new workbook
    If sh.Visible = -1 Then
        sh.Copy

        'Set Destwb to the new workbook
        Set Destwb = ActiveWorkbook

        'Determine the Excel version and file extension/format
        With Destwb
            FileExtStr = ".txt": FileFormatNum = -4158
        End With

        'Change all cells in the worksheet to values if you want
        'I get error in this if statement.

        If Destwb.Sheets(1).ProtectContents = False Then
            With Destwb.Sheets(1).UsedRange
                .Cells.Copy
                .Cells.PasteSpecial xlPasteValues
                .Cells(1).Select
            End With
            Application.CutCopyMode = False
        End If
        'Save the new workbook and close it
        With Destwb
            .SaveAs FolderName _
                  & "\" & Destwb.Sheets(1).Name & FileExtStr, _
                    FileFormat:=FileFormatNum
            .Close False
        End With
    End If
GoToNextSheet:
Next sh
MsgBox "You can find the files in " & FolderName
Sheets("Main Page").Select
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
Sheets("Main Page").Select
ActiveWorkbook.Save

End Sub
4

1 回答 1

1

代替

    If Destwb.Sheets(1).ProtectContents = False Then 
        With Destwb.Sheets(1).UsedRange 
            .Cells.Copy 
            .Cells.PasteSpecial xlPasteValues 
            .Cells(1).Select 
        End With 
        Application.CutCopyMode = False 
    End If

也许尝试：

    If Destwb.Sheets(1).ProtectContents = False Then 
        Destwb.Sheets(1).UsedRange.value = Destwb.Sheets(1).UsedRange.value 
    End If
于 2012-10-16T18:54:57.813 回答