我一直致力于一个项目,该项目需要许多输入工作簿并将某些选项卡复制到某些输出工作簿中。在每个输出工作簿上,我需要断开指向输入工作簿的链接,但是如果工作簿可见并且调用了.Activate,我只能使它工作。
是否还有其他方法可以中断链接以便我可以隐藏工作簿(.visible = false)并让用户在后台处理时使用其他程序(不使用.activate)?
这是我为这个问题汇总的一个小例子(主要程序我有更多的处理方式,我不想让你们对所有这些进行排序)
Dim ExcelInst As New Excel.Application 'New excel instance so I can make it invisible
Dim InputWorkbook As Workbook 'input workbook with tabs 2&3 containing links to tab 1
Dim OutputWorkbook1 As Workbook 'output workbook 1 will get tab 2
Dim OutputWorkbook2 As Workbook 'output workbook 2 will get tab 3
Dim InputFileName As String 'input file name
Dim OutputFileName1 As String 'output 1 file name
Dim OutputFileName2 As String 'output 2 file name
Private Sub TestButtonA_Click() 'Test button in main workbook
ExcelInst.Visible = True 'If this is set to false then BreakLinks does not work
InputFileName = ThisWorkbook.Path & "\TestInputWorkbook.xlsx" 'Set the input file name
OutputFileName1 = ThisWorkbook.Path & "\TestOutputWorkbook1.xlsx" 'Set output 1 file name
OutputFileName2 = ThisWorkbook.Path & "\TestOutputWorkbook2.xlsx" 'Set output 2 file name
Set InputWorkbook = ExcelInst.Workbooks.Open(FileName:=InputFileName) 'Open the input file in the new excel instance
Set OutputWorkbook1 = ExcelInst.Workbooks.Add 'Add workbook to instance for output 1
Set OutputWorkbook2 = ExcelInst.Workbooks.Add 'Add workbook to instance for output 2
InputWorkbook.Sheets(2).Copy After:=OutputWorkbook1.Sheets(1) 'Copy sheet 2 to workbook 1
InputWorkbook.Sheets(3).Copy After:=OutputWorkbook2.Sheets(1) 'Copy sheet 3 to workbook 2
OutputWorkbook1.Activate 'If the workbook is not "active" then break links will not work
Call BreakLinks(OutputWorkbook1) 'Break links on output 1
OutputWorkbook2.Activate 'If the workbook is not "active" then break links will not work
Call BreakLinks(OutputWorkbook2) 'Break links on output 2
InputWorkbook.Close SaveChanges:=False 'Close input workbook
OutputWorkbook1.SaveAs (OutputFileName1) 'Save output 1
OutputWorkbook2.SaveAs (OutputFileName2) 'Save output 2
OutputWorkbook1.Close SaveChanges:=True 'Close output 1
OutputWorkbook2.Close SaveChanges:=True 'Close output 2
ExcelInst.Quit 'Close the excel instance
Set ExcelInst = Nothing 'Just to make sure
End Sub
'This is a function that I have seen on many other stackoverflow posts I don't remember which one I copied from
Public Function BreakLinks(ByRef wb As Workbook)
Dim Links() As Variant
Dim i As Integer
On Error Resume Next
Links = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
On Error GoTo 0
If HasElements(Links) Then
For i = LBound(Links) To UBound(Links)
wb.BreakLink Name:=Links(i), Type:=xlLinkTypeExcelLinks
Next i
End If
End Function
'IsEmpty() was throwing some errors so I found another stackoverflow post that had an alternative
Public Function HasElements(testArr As Variant) As Boolean
Dim lngUboundTest As Long
lngUboundTest = -1
On Error Resume Next
lngUboundTest = UBound(testArr)
On Error GoTo 0
HasElements = lngUboundTest >= 0
End Function