没有.Activate的VBA Excel Break链接

时间:2017-07-06 14:50:47

标签: excel vba break visible

我一直致力于一个项目,该项目需要许多输入工作簿并将某些选项卡复制到某些输出工作簿中。在每个输出工作簿上,我需要断开指向输入工作簿的链接,但是如果工作簿可见并且调用了.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

0 个答案:

没有答案