工作表复制时链接断开的VBA问题

时间:2018-12-22 16:05:25

标签: excel vba excel-vba

我有一个工作表,该工作表基于给定的日期和飞机号,将生成报告和3个图表。因为我必须在一个报告中报告所有飞机的状态,所以我开发了一个程序来循环浏览飞机号,并在源工作表中更改飞机号后,将它们复制到新的工作簿中。我还将图表从该工作表移动到该新工作簿的另一工作表中,并且在做一些额外的事情。
 我需要断开源工作簿中新工作簿/工作表的连接。否则,图表名称或其他相关单元格将读取最新的飞机编号表格。我已经添加了一条用于断开连接的行,也正在从新工作簿中删除所有名称,但是仍然无法真正终止这种数据连接。我尝试遍历所有链接,并在复制工作表后将其杀死,但再次无法正常工作。
  现在,我的代码正在运行,并通过使用NewWB.BreakLink ThisWorkbook.FullName, xlExcelLinks来显示正确的信息,但是该过程非常不稳定并且总是崩溃。我尝试将application.wait添加一秒钟,但是再次崩溃。但是,当我在循环中添加切换断点并不断按F5时,它工作正常!这是我认为相关的那部分代码。在手动进行计算,未启用事件且关闭屏幕更新的情况下,此代码正在运行。

    For i = UBound(CurAC) To LBound(CurAC) Step -1
    If CurAC(i) = "" Then GoTo Skip
    WS.Cells(6, 2) = CurAC(i)
    DeleteCharts WSC
    ChartNew CLng(CurAC(i))
    WS.Calculate
    If WSC.ChartObjects.Count > 0 Then WSC.ChartObjects(1).Chart.ChartArea.Copy

    Set NewWS = NewWB.Worksheets.Add
    With NewWS

        .Name = CurAC(i) & "Chart"
        .Activate
        .Range("a1").Select
        If WSC.ChartObjects.Count > 0 Then .Pictures.Paste
        Application.CutCopyMode = False
        With .Shapes(1)
            .LockAspectRatio = msoTrue
            .Width = .Parent.Range("k1").Left

        End With
        WS.Copy NewWB.Sheets(1)
        ActiveSheet.Name = CurAC(i)
        Set ACWS = ActiveSheet
        NewWB.BreakLink ThisWorkbook.FullName, xlExcelLinks
        Set ChtOb = ACWS.ChartObjects(1)
        ChtOb.Top = .Range("a23").Top
        ChtOb.Width = 360
        ChtOb.Left = .Range("a23").Left
        ChtOb.Chart.Location xlLocationAsObject, .Name
        Set ChtOb = ACWS.ChartObjects(1)
        ChtOb.Top = .Range("i23").Top
        ChtOb.Width = 360
        ChtOb.Left = .Range("p23").Left - ChtOb.Width
        ChtOb.Chart.Location xlLocationAsObject, .Name
' third chart
        Set ChtOb = ACWS.ChartObjects(1)
        ChtOb.Top = .Range("k1").Top
        ChtOb.Width = 245
        ChtOb.Left = .Range("p1").Left - ChtOb.Width
        ChtOb.Chart.Location xlLocationAsObject, .Name

        With .PageSetup
            .PrintArea = "$A$1:$o$40" '.Range().Address
            .Orientation = xlLandscape
            .Zoom = False
            .FitToPagesTall = 1
            .FitToPagesWide = 1
            .LeftMargin = Application.InchesToPoints(0.1)
            .RightMargin = Application.InchesToPoints(0.1)
            .TopMargin = Application.InchesToPoints(0.15)
            .BottomMargin = Application.InchesToPoints(0.15)
            .HeaderMargin = Application.InchesToPoints(0.1)
            .FooterMargin = Application.InchesToPoints(0.1)

        End With

    End With
    ACWS.Activate
Skip:

'    NewWB.Save
    Debug.Print CurAC(i); vbTab; Round(Timer - t, 1)
    Application.Wait Time + TimeValue("00:00:01")
    RemoveName NewWB
    NewWB.BreakLink ThisWorkbook.FullName, xlExcelLinks
Next

0 个答案:

没有答案