メインフレームから引き出されたデータで作業を続けています。データは大部分が英数字であり、過去の取り組みに基づいて機能を構築し続けています。シートが移動するループは、この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ですか? また、ワークシートを新しく生成されたワークブックに移動するには、このエラーをどのように修正すればよいですか?