1

我正在继续处理从大型机中提取的数据。数据主要是字母数字,是在过去努力的基础上构建功能的延续。移动工作表的循环是基于此SO 文章中讨论的函数创建的。

我已经查阅了这篇SO 文章并独立测试了此类功能的一般形式,但在这种特定情况下此类代码失败,可​​能是由于版本问题或我引用新工作簿的方式。

我编写了一个子程序,将工作表从一个工作簿转移到另一个工作簿。它与绑定到复选框的公共变量一起使用,旨在为用户提供一种简单的方式来移植表单数据。如果复选标记处于选中状态,则公共变量用于有条件地调用子例程。

代码如下:

Public Sub MoveSheets()

' This macro moves all sheets but those noted within the If statements,(1)
' (1) which are further nested within the For Each loop.

'See http://msdn.microsoft.com/en-us/library/office/ff198017.aspx for save file format types.
'The file format of this excel macro sheet is 52: xlOpenXMLWorkbookMacroEnabled
'The default save type for the use-case is excel 2003 is compatibility mode.
'The macro is to set the current save type to one compatible with 52.
'In this case, 51: xlOpenXMLWorkbook was selected as the selected type.

'Define Excel Format storage variables.
Dim FileFormatSet As Excel.XlFileFormat
Dim OriginalFileFormatSet As Excel.XlFileFormat
Dim TempFileFormatSet As Excel.XlFileFormat


'Define worksheet/workbook variables.
Dim IndividualWorkSheet As Worksheet
Dim NewWorkBook1 As Workbook

'Set variable to store current time.
Dim CurrentTime As Date

'The original file format.
OriginalFileFormatSet = Application.DefaultSaveFormat

'The file format to be used at the end of the procedure after all is said and done.
FileFormatSet = OriginalFileFormatSet

'The currently desired file format.
TempFileFormatSet = xlOpenXMLWorkbook

'The currently desired file format set as the set default.
Application.DefaultSaveFormat = TempFileFormatSet

'Disable application alerts. Comment the line below to display alerts (2)
'(2) in order to help check for errors.
Application.DisplayAlerts = False

'Save new workbook "NewWorkBook" as default file format.
Workbooks.Add.SaveAs Filename:="NewWorkBook", FileFormat:=Application.DefaultSaveFormat

'Set variable to new workbook "NewWorkBook", which is in .xlsx format.
Set NewWorkBook1 = Workbooks("NewWorkBook.xlsx")

'Activate Macro Window.
Windows("ShifterMacro.xlsm").Activate
'For each worksheet, shift it to the workbook "NewWorkBook" if (3)
'(3) it fails outside the criteria set listed below.
For Each IndividualWorkSheet In ThisWorkbook.Worksheets
    If IndividualWorkSheet.Name <> "Sheet1" And IndividualWorkSheet.Name <> "Criteria" And _
    IndividualWorkSheet.Name <> "TemplateSheet" And IndividualWorkSheet.Name <> "TemplateSheet2" And _
    IndividualWorkSheet.Name <> "Instructions" And IndividualWorkSheet.Name <> "Macro1" And _
    IndividualWorkSheet.Name <> "DataSheet" Then

            'Select each worksheet.
            IndividualWorkSheet.Select

            'Shift the worksheetover to the new workbook.
            '****NOTE: THIS CODE CURRENTLY RESULTS IN A '1004' RUN-TIME ERROR.****
            IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count

    End If
Next

'An ugly set of If Then statements to clean the new workbook (4)
'(4) of its previous sheets, assuming entries are to be made.
If NewWorkBook1.Sheets.Count > 1 Then

    NewWorkBook1.Sheets("Sheet1").Delete

End If

If NewWorkBook1.Sheets.Count > 1 Then

    NewWorkBook1.Sheets("Sheet2").Delete

End If

If NewWorkBook1.Sheets.Count > 1 Then

    NewWorkBook1.Sheets("Sheet3").Delete

End If

'********** CODE CHECKED BUT UNTESTED WITHIN THESE BOUNDARIES **********

'Activate the Window for the new workbook if it is inactive.
Windows("NewWorkBook.xlsx").Activate

'If the number of sheets are greater than 1... (5)
If Sheets.Count > 1 Then

    '(6) The time value is parsed to remove unusual characters, following (5)
    '(6) the logic of this SO article: https://stackoverflow.com/questions/11364007/save-as-failed-excel-vba.

    'Formatted current time as per http://www.mrexcel.com/forum/excel-questions/273280-visual-basic-applications-format-now-yyyymmddhhnnss.html
    CurrentTime = Format(Now(), "yyyy-mm-dd-hh-nn-ss")

    '(5) Then go ahead and save the file with the current date/time information.
    NewWorkBook1.SaveAs Filename:="Form_Data_" & Now, FileFormat:=Application.DefaultSaveFormat

End If

'Set SaveChanges = True, as per https://stackoverflow.com/questions/9327613/excel-vba-copy-method-of-worksheet-fails
ActiveWorkbook.Close SaveChanges:=True

'********** END CODE BOUNDARY **********

'Activate the Window for the Macro.
Windows("ShifterMacro.xlsm").Activate

'Activate a specific sheet of the Macro.
ActiveWorkbook.Sheets("Instructions").Activate

'Change Display Alerts back to normal.
Application.DisplayAlerts = True

'Reset the view for the original data sheet.
With Sheets("Sheet1")

'For when this process is repeated.
If .FilterMode Then .ShowAllData

End With

'Return the Default save format to the original file format.
Application.DefaultSaveFormat = FileFormatSet

End Sub

代码在第 62 行失败,并导致“1004”运行时错误:

IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count

引用的工作表包含“100-AAA”的正确测试值。Sheets.Count 等于 3。NewWorkBook1 变量保存值NewWorkBook.xslx。生成的工作簿“NewWorkBook.xslx”的路径与宏工作簿相同。我的 excel 版本是 2007,尽管我的用户的默认版本是 2003,尽管他们有 2007 的容量和安装。

为什么我会Move出现此运行时错误,如何更正此错误以将我的工作表转移到新生成的工作簿中?

4

1 回答 1

4

这:

IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count

只是指定在同一个工作簿中移动工作表(如果 NewWorkBook1 的工作表比其父工作簿多,则会出错)

也许尝试:

IndividualWorkSheet.Move After:=NewWorkBook1.Sheets(NewWorkBook1.Sheets.Count)

于 2012-08-15T18:58:13.160 回答