Question

在我问过的其他问题上，我一直在围着这个问题殴打，但是我遇到了障碍，需要帮助。截至目前，我的代码打开了一个xltx文件，基于Select Case函数创建了一个新的工作表和/或copys值，从xlsm文件到xltx。有5种情况，“单一测试”“位置1”“位置2”“位置3”和“位置4”。仅在位置1和单个测试中创建新工作表，并根据单元格中的内容命名工作表，然后将值从xlsm粘贴到xltx。位置2-4将仅粘贴到此模板文件中新创建的工作表。 此项目的目的是比较来自多个测试部分的数据，这意味着此代码需要重复多次运行。

它是如何工作的。

该部件经过4次测试，测试软件使用我制作的excel xlsm模板文件为每个部件创建4个报告。该文件包含所有编码。基于A1中的内容是否是位置1-4，选择案例做了不同的事情。位置1打开xltx，创建一个新工作表并以该部件命名，并粘贴报告中的值。位置2-3只需将报表中的值粘贴到xltx即可。位置4粘贴值并根据4个粘贴位置创建数据图表。然后当下一部分运行时，我需要它在同一个打开的xltx和新工作表中重复上述所有内容。每个报告都在同一个xlsm文件中打开，因此它们在代码和除数据之外的所有内容都是相同的。

我遇到的问题如下：

一旦代码打开xltx文件，它就会以filename1的形式打开它，如何在代码中引用它？
它无法重新打开xltx，因为它将以filename2，filename3等打开。因此，我需要一个if已经打开的语句，但是如何引用已经打开的xltx。

测试软件的报告

我有以下代码，它可以工作，但如果第二次运行它重新打开xltx：

  Option Explicit
Sub ExportSave()

Dim Alpha           As Workbook 'Template
Dim Omega           As Worksheet 'Template
Dim wbMain          As Workbook 'Main Export file
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    'Destination
Dim Shtname1        As String   'New Sheet Name Part Plateform
Dim Shtname2        As String   'New Sheet Name Part #
Dim Shtname3        As String   'New Sheet Name Part Info
Dim rep             As Long

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("E2").Text
FileTimeDate = Sheets("Sheet1").Range("H30000").Text
FileD = Sheets("Sheet1").Range("E3").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
    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
    ActiveWorkbook.Close False

    Set Alpha = Workbooks.Open("\\plymshare01\Public\Holiday\FRF Projects\Templates\FRF Data Graphs.xltx")


    Shtname1 = wbMain.Sheets("Sheet1").Range("E2")
    Shtname2 = wbMain.Sheets("Sheet1").Range("E3")
    Shtname3 = wbMain.Sheets("Sheet1").Range("E4")

    For rep = 1 To (Worksheets.Count)
        If LCase(Sheets(rep).Name = LCase(Shtname1 & Space(1) & Shtname2 & Space(1) & Shtname3)) Then
            MsgBox "This Sheet already exists"
            Exit Sub
        End If
    Next

    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(ActiveSheet.Name).Name = Shtname1 & Space(1) & Shtname2 & Space(1) & Shtname3


            Set Omega = Workbooks(ActiveWorkbook.Name).Sheets(ActiveWorksheet.Name)

            locs = Array("FRF Data Export Graphs.xlsm")



                    'set the first data block destination
                        Set rngDest = Omega.Cells(3, 1).Resize(30000, 3)

                    For Each loc In locs

                    Set Extract = Workbooks.Open(FileName:=FPATH & loc, ReadOnly:=True)

                    rngDest.Value = Extract.Sheets("Sheet1").Range("A4:D25602").Value

                    Extract.Close False

                    Set rngDest = rngDest.Offset(0, 4) 'move over to the right 4 cols

                    Next loc



        Application.ScreenUpdating = True

    Case "Location 2"

        MsgBox "Code needed"

    Case "Location 3"

        MsgBox "Code needed"

    Case "Location 4"

        MsgBox "Code needed"

    Case Else

        MsgBox "Export Failed!"

    End Select


    Application.DisplayAlerts = True

  End Sub

在代码

0 个答案: