Question

我有2个工作簿，一个有vba（MainWb），另一个只是一个模板（TempWb）代码粘贴值和mainworkbook中的公式。 TempWb只有一个名为图的空白表。代码需要打开xltx文件（TempWb），添加工作表并根据MainWb上某个单元格中的值重命名（如果它尚不存在），然后从MainWb引用复制值过程中的新工作表。我尝试录制一个宏，但它并没有真正帮助。我已经研究并将一些东西放在一起，但不确定它是否合适和有效。任何建议将不胜感激。

这是我到目前为止所拥有的。

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    'Paste Value Range
    Dim Shtname1        As String   'Part Platform
    Dim Shtname2        As String   'Part Drawing Number
    Dim Shtname3        As String   '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\"
    Shtname1 = wbMain.Sheets("Sheet1").Range("E2")
    Shtname2 = wbMain.Sheets("Sheet1").Range("E3")
    Shtname3 = wbMain.Sheets("Sheet1").Range("E4")

    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.Close False

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

            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

            With ActiveWorksheet.Range("D3:D25603").Formula = "=SQRT((B3)^2+(C3)^2)"

            ActiveWorkbook.Charts.Add
            ActiveChart.ChartType = xlXYScatterLines
            ActiveChart.SetSourceData Source:=Sheets("Graphs").Range("A3:D7"), PlotBy:=xlRows
            ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=Shtname2

            With ActiveChart
                .HasTitle = True
                .ChartTitle.Characters.Text = Shtname2
                .Axes(xlCategory, xlPrimary).HasTitle = True
                .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Hz"
                .Axes(xlValue, xlPrimary).HasTitle = True
                .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Blank"
            End With

            Application.ScreenUpdating = True
        Case "Location 2"
        Case "Location 3"
        Case "Location 4"
        Case Else
            MsgBox "Export Failed!"

    End Select
    Application.DisplayAlerts = True

 End Sub

运行时错误＆＃39; 91＆＃39; 对象变量或未设置块代码行

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

这应该告诉代码命名新创建的工作表

修正：移至

Set = wbMain = Workbooks("FRF Data Export Graphs.xlsm")

新错误： 对象不支持此属性或方法代码

   If LCase(Sheets(rep)).Name = LCase(Shtname1 & Space(1) & Shtname2 & Space(1) & Shtname3) Then

Answer 1

这里可能会发生一些事情

Shtname1 = wbMain.Sheets("Sheet1").Range("E2")

您正尝试访问三个对象并设置第三个对象。这意味着需要设置wbMain，并且需要设置Sheets("Sheet1")并且Range("E2")需要存在。

您也是，因为您将Shtname1设置为字符串，我会明确说明您希望在那里获得什么价值。

Shtname1 = wbMain.Sheets("Sheet1").Range("E2").Value

因此，使用该行上的断点并打开本地窗口（View＆gt; Locals Window），确保一切都已设置。如果不是这样的话。其中一个值未设置。

如果您执行infact Set wbMain = Workbooks("FRF Data Export Graphs.xlsm")但它位于不同的模块或不同的子模块中，并且wbMain在此子组的顶部重新声明，则这些语句处于完全不同的上下文中。第一个wbMain基本上是一个不同的变量。

创建新工作表（如果不存在），根据单元格值重命名，然后引用该工作表

1 个答案: