代码之家 › 专栏 › 技术社区 › Mahhdy

图纸复制时链接中断的VBA问题

excel-vba vba excel

Mahhdy · 技术社区 · 6 年前

我有一份基于给定日期和飞机的工作表,将生成一份报告和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 回复 | 直到 5 年前