在代码中引用模板文件

我正在尝试开发一个代码和文件系统来比较使用graphics的不同部分的testing报告。 我得到一个testing报告,每个零件4个部件的testing位置,看起来像这样。 (这是25603行) 报告

当testing软件生成报告并打开时,我有一个Auto_Openmacros,它执行以下操作:保存2个文件,一个基于A1(位置1,2,3,4)中的内容命名并保存在父文件夹中数据提取,另一个是备份副本。 然后它应该打开这个名为“FRF Data Graphs”的模板文件,这是一个xltx。 模板

然后代码将复制许多单元格并粘贴到FRF Data Graphs1中。 我使用每个位置的select案例,告诉代码从这里复制并粘贴在这张表中,每个位置4张1,如果是“”。 因为我比较零件,每次打开一个新的报告,这个macros就运行了。我正在使用右移到下一个空白部分(第1,2,3,4部分)。

我得到2个不同的错误代码,第一个只发生在graphics在报告中。 错误

第二个是下标超出范围两个错误都在同一行代码下,所有的*都在。

Set Omega = Workbooks("FRF Data Graphs1.xltx").Sheets("Location 1") 

那么我的代码有什么问题? 如何引用模板文件,并且不能使用复杂graphics使用的单元格中的数据?

  Option Explicit Sub ExportSave() Dim Alpha As Workbook 'Template Dim Omega As Worksheet 'Template Dim FileTL As String 'Test location Dim FilePath As String 'File save path Dim FileProject As String 'Project information Dim FileTimeDate As String 'Export Date and Time Dim FileD As String 'Drawing Number Dim FileCopyPath As String 'FileCopy save path Dim FPATH As String 'File Search Path Dim Extract As Workbook 'File Extract Data Dim locs, loc 'Location Search Dim intLast As Long 'EmptyCell Search Dim intNext As Long 'EmptyCell Seach Dim rngDest As Range With Range("H30000") .Value = Format(Now, "mmm-dd-yy hh-mm-ss AM/PM") End With FilePath = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test" FileCopyPath = "C:\Users\aholiday\Desktop\Backup" FileTL = Sheets("Sheet1").Range("A1").Text FileProject = Sheets("Sheet1").Range("G2").Text FileTimeDate = Sheets("Sheet1").Range("H30000").Text FileD = Sheets("Sheet1").Range("G3").Text FPATH = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\" Select Case Range("A1").Value Case "Single Test Location" Case "Location 1" Application.DisplayAlerts = False ThisWorkbook.SaveAs FileName:=FileCopyPath & "\" & FileProject & Space(1) & FileD & Space(1) & FileTL & Space(1) & FileTimeDate & ".xlsx", FileFormat:=xlOpenXMLWorkbook ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileTL & ".xlsx" Set Alpha = Workbooks.Open("\\plymshare01\Public\Holiday\FRF Projects\Templates\FRF Data Graphs.xltx") locs = Array("Location 1.xlsx") Set Omega = Workbooks("FRF Data Graphs1.xls").Sheets("Location 1") 'set the first data block destination intLast = Omega.Cells(Columns.Count, "1").End(xlRight).Column intNext = intLast + 5 - (intLast + 5) Mod 5 Set rngDest = Omega.Cells(intNext, "A").Resize(30000, 3) For Each loc In locs Set Extract = Workbooks.Open(FileName:=FPATH & loc, ReadOnly:=True) rngDest.Value = Extract.Sheets("Sheet1").Range("A3:A30000", "D3:D30000").Value Extract.Close False Set rngDest = rngDest.Offset(0, 3) 'move over to the right 3 cols Next loc Application.ScreenUpdating = True Case "Location 2" Case "Location 3" Case "Location 4" Case Else MsgBox "Export Failed!" End Select Application.DisplayAlerts = True End Sub 

以下问题在您的代码中:

 Set Omega = Workbooks("FRF Data Graphs1.xls").Sheets("Location 1") 

这会给.xltx文件打开一个新模板时提供一个错误,Excel保存之前不会提供文件types扩展名。 此外, Sheets("Location 1")引用不正确,应该是Sheets("Location1 Raw Data")

解决scheme:

 Set Omega = Workbooks(ActiveWorkbook.Name).Sheets("Location1 Raw Data") 

这解决了正确的命名,并且每当Excel打开一个新的实例(并且Excel仍然打开)时,它将得到一个新的数字,因此对1的引用将变得无用。

第二个问题是由.SaveAs创build的。由于这样可以保存工作簿,但原始工作簿不再打开,因为稍后打开Location 1.xlsx文件时只能读取您的代码停止位。

解决这个问题。 .Copy Sheet并保存。

码:

 Set wbMain = Workbooks("FRF Data Export Graphs.xlsm") wbMain.Sheets("Sheet1").Copy ActiveWorkbook.SaveAs FileName:=FileCopyPath & "\" & FileProject & Space(1) & FileD & Space(1) & FileTL & Space(1) & FileTimeDate & ".xlsx", FileFormat:=xlOpenXMLWorkbook ActiveWorkbook.SaveAs FileName:=FilePath & "\" & FileTL & ".xlsx" ActiveWorkbook.Close False 

您还需要将dim wbMain as Workbook定义dim wbMain as Workbook
这是.Copy的工作簿,并在保存后closures它。

最后的问题(假设模板总是空的)是设置你的rngDest因为它总是一个新的模板,不需要find一个空的范围。

 Set rngDest = Omega.Cells(3, 1).Resize(30000, 3) 

这将做的伎俩。