0

我有一个由其他人构建的代码（见下方此消息的底部），它在 excel 2010 中运行良好，但我们的管理人员将我们迁移到 excel 2019。现在相同的代码产生错误。我还尝试检查 vba 中的参考库中是否有新的加载项或引用，但没有找到任何可以消除错误或允许代码正确执行的内容。

代码的功能基本是这样的：

该代码链接到工作簿中工作表中的数据透视表。它会问用户几个问题，例如这是一个“RFQ”，然后会打开一个消息框供他们输入文件名。然后它会询问用户是否希望将数据添加到同一工作簿中的另一个工作表中。在回答完所有这些问题后，代码应该打开一个新工作簿，并将隐藏工作表中的数据从原始工作簿复制/粘贴到这个新工作簿中。这个新工作簿应该成为焦点，并允许用户在保存和关闭它之前进行任何其他更改。

代码自动将新工作簿保存在原始工作簿中另一个隐藏工作表上的单元格引用的位置（使用 HLink）。

现在发生的错误是：“以下功能无法保存在无宏工作簿中：VB 项目 要保存具有这些功能的文件，请单击否，然后在文件类型列表中选择启用宏的文件类型。要继续另存为无宏工作簿，请单击是。

如果用户说是，它会说刚刚创建的新工作簿“已经存在于这个位置。你想换吗？”

如果你说是，一切都会变成空白，你必须重新启动 excel。如果您说不，vba 调试器将打开到代码的末尾，突出显示代码的最后一部分：

ActiveWorkbook.SaveAs FileName:=HLink _ , FileFormat:"xlOpenXMLWorkbook, CreateBackup:=False

我尝试更改代码的某些部分。由此：

`'Save
On Error GoTo ErrFileClose:
HLink = (FilePath & "\" & FileName & "_" & Format(Date, "[$-409]yyyy-mm-d;@") & ".xlsx")
ActiveWorkbook.SaveAs FileName:=HLink _
    , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If`

对此：

'Save
On Error GoTo ErrFileClose:
HLink = (FilePath & "\" & FileName & "_" & Format(Date, "[$-409]yyyy-mm-d;@"))
ActiveWorkbook.SaveAs FileName:=HLink _
    , FileFormat:=51, CreateBackup:=False
End If

同样，由此：

'Check if previously created file is open and close it so new one can be saved
    ErrFileClose:
        FinalFileName = FileName & "_" & Format(Date, "[$-409]yyyy-mm-d;@") & ".xlsx"
        Workbooks(FinalFileName).Close SaveChanges:=True
        ActiveWorkbook.SaveAs FileName:=HLink _
           , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

对此：

   'Check if previously created file is open and close it so new one can be saved
ErrFileClose:
    FinalFileName = FileName & "_" & Format(Date, "[$-409]yyyy-mm-d;@")
    Workbooks(FinalFileName).Close SaveChanges:=True
    ActiveWorkbook.SaveAs FileName:=HLink _
        , FileFormat:=51, CreateBackup:=False

这些更改有时会有所帮助，并且似乎消除了 vb 项目错误，但每次运行宏时都不一致。
感谢任何帮助，因为我们无法继续使用它。谢谢。

Sub ImportFile()
'
' ImportFile Macro

Call UnprotectAll

'Create Import
    Dim curWorkbook As Workbook
    Dim ReqType As String
    Dim FileName As String
    Dim FinalFileName As String
    Dim FilePath As String
    FilePath = Sheets("X").Range("C3").Value
    Dim HLink As String
    
    Application.ScreenUpdating = False
    
    Sheets("Import").Visible = True
    Sheets("Import").Copy
    ActiveSheet.Unprotect
'Edit import to remove formulas and blank rows
    Range("A1:AC500").Value = Range("A1:AC500").Value
    Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Set curWorkbook = ActiveWorkbook
    
    Windows("Transactions.xlsm").Activate
    Sheets("Import").Visible = False
    curWorkbook.Activate
    
'Save Import
    
    ReqType = MsgBox("Click YES if you are creating an RFQ", vbYesNoCancel)
    'vbCancel = 2, vbYes = 6, vbNo = 7
        If ReqType = 6 Then
            ReqType = "RFQ"
        Else
            If ReqType = 7 Then
                ReqType = "Ordered"
            Else
                Exit Sub
            End If
        End If
    FileName = InputBox("Please enter the Incident number or other Unique ID Number to save this file as:")
    
'Cancel Save
    If FileName = "" Then
        ActiveWorkbook.Close SaveChanges:=False
        Call ProtectAll
        Application.ScreenUpdating = True
        MsgBox ("File Not Created")
        Exit Sub
    Else
    
'Save
    On Error GoTo ErrFileClose:
    HLink = (FilePath & "\" & FileName & "_" & Format(Date, "[$-409]yyyy-mm-d;@") & ".xlsx")
    ActiveWorkbook.SaveAs FileName:=HLink _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    End If

'Add Order to Receive tab ?
    If MsgBox("Ok to add this data as Transaction: " & ReqType & "?", vbOKCancel) = vbOK Then
    Windows("Transactions.xlsm").Activate
    Else
    
'Do Not add Order to transactions Order - Receipt
        ActiveWorkbook.Close SaveChanges:=False
        Call ProtectAll
        Application.ScreenUpdating = True
        MsgBox ("This has not been added as a transaction. Click the HuB button when ready to try again.  A new import file will be created and can be saved over the one just created.")
    Exit Sub
    End If

'AddOrder to Transactions Order - Receipt
    ActiveSheet.PivotTables("ToBeOrderedPivot").RowRange.Select
    
'Remove headers and column 1
    Selection.Offset(1, 1).Resize(Selection.Rows.Count - 1, _
    Selection.Columns.Count).Select

'Remove Extra Columns
    Dim FirstRow As Integer
    Dim LastRow As Integer
    
    FirstRow = Selection.Row
    LastRow = FirstRow + Selection.Rows.Count - 1
    Range("C" & FirstRow & ":F" & LastRow & ",AA" & FirstRow & ":AA" & LastRow & ",L" & FirstRow & ":L" & LastRow).Select
    Selection.SpecialCells(xlCellTypeVisible).Copy
    
'Move to end of Orders  table
    Sheets("Receive").Select
    Count = Range("Orders[Mtl ID]").Rows.Count
    Range("B" & Count + 4).Select
    
'Paste Values
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
'Set Values
    
    Selection.Offset(0, 8).Columns(1).Value = Selection.Offset(0, 2).Columns(1).Value
    If ReqType = "RFQ" Then
    Selection.Offset(0, 2).Columns(1).Value = 0
    Selection.Offset(0, 7).Columns(1).Value = ReqType
    Else: Selection.Offset(0, 2).Columns(1).Value = Selection.Offset(0, 5).Columns(1).Value
    End If
    Selection.Offset(0, 5).Columns(1).Value = Selection.Offset(0, 3).Columns(1).Value
    Selection.Offset(0, 3).Columns(1).Value = Selection.Offset(0, 4).Columns(1).Value
    Selection.Offset(0, 4).Columns(1).Value = Selection.Offset(0, 8).Columns(1).Value
    Selection.Offset(0, 8).Columns(1).Value = FileName
    Selection.Offset(0, 9).Columns(1).Value = Format(Date, "[$-409]yyyy-mm-d;@")
    
    
    
        
 'Sort Table
    Call SortReceive
    Call ProtectAll
    Application.ScreenUpdating = True
    
'Return to Import File
    curWorkbook.Activate
    
Exit Sub

'Check if previously created file is open and close it so new one can be saved
ErrFileClose:
    FinalFileName = FileName & "_" & Format(Date, "[$-409]yyyy-mm-d;@") & ".xlsx"
    Workbooks(FinalFileName).Close SaveChanges:=True
    ActiveWorkbook.SaveAs FileName:=HLink _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    Resume Next
    
End Sub
4

0 回答 0