0

以下のコードにはいくつか問題があります。あるファイルから別のファイルにチャートをコピー アンド ペーストしてから、チャートの元のファイルを閉じています。デバッガーでコードをステップ実行するとすべて正常に動作しますが、シートのボタンを使用してプロシージャを起動すると、エラーが発生します: オブジェクトが見つかりませんでした。

を使用しているにもかかわらず、手順中にちらつきも発生しますApplication.ScreenUpdating = False。

誰でも助けることができますか？どんな助けでも大歓迎です!!!

ありがとう

Application.ScreenUpdating = False

Windows("Overhead Display.xls").Activate
Sheets("CHART DISPLAY - FINISH").Activate
Application.DisplayFullScreen = True
ActiveSheet.ChartObjects("ChartImage").Activate
ActiveSheet.ChartObjects("ChartImage").Delete

ChDir _
    "C:\...FILES"
Workbooks.Open Filename:= _
    "C:\...BLACK.xls"
Sheets("RYG CHARTS").Visible = True
Sheets("RYG CHARTS").Activate
ActiveSheet.Unprotect Password:="052100F"
ActiveSheet.ChartObjects("Chart 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
ActiveWindow.Visible = False
Windows("Overhead Display.xls").Activate
ActiveSheet.Paste
'Rename chart to delete later
ActiveChart.Parent.Name = "ChartImage"
ActiveSheet.ChartObjects("ChartImage").Activate
ActiveSheet.Shapes("ChartImage").Top = 100
ActiveSheet.Shapes("ChartImage").Width = 700
ActiveSheet.Shapes("ChartImage").Height = 375
ActiveSheet.Shapes("ChartImage").Left = 20


'ActiveWindow.Visible = False
Windows("Overhead Display.xls").Activate
Range("A1").Select
With ActiveWindow
    .DisplayGridlines = False
    .DisplayHeadings = False
    .DisplayHorizontalScrollBar = False
    .DisplayVerticalScrollBar = False
    .DisplayWorkbookTabs = False
End With



Windows("BMW F25 OUTERBELT BLACK.xls").Activate
Sheets("FILE SETUP").Activate
ActiveSheet.Unprotect Password:="052100AF"
Range("J2").Select
Selection.Copy
Windows("Overhead Display.xls").Activate
Sheets("CHART DISPLAY - FINISH").Activate
Range("K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Windows("BMW F25 OUTERBELT BLACK.xls").Activate
Range("J3").Select
Selection.Copy
Windows("Overhead Display.xls").Activate
Sheets("CHART DISPLAY - FINISH").Activate
Range("J3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Windows("BMW F25 OUTERBELT BLACK.xls").Activate
Range("D2").Select
Selection.Copy
Windows("Overhead Display.xls").Activate
Sheets("CHART DISPLAY - FINISH").Activate
Range("L4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Windows("BMW F25 OUTERBELT BLACK.xls").Activate
Range("D3").Select
Selection.Copy
Windows("Overhead Display.xls").Activate
Sheets("CHART DISPLAY - FINISH").Activate
Range("N3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Windows("BMW F25 OUTERBELT BLACK.xls").Activate
Range("H13").Select
Selection.Copy
Windows("Overhead Display.xls").Activate
Sheets("CHART DISPLAY - FINISH").Activate
Range("U11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Windows("BMW F25 OUTERBELT BLACK.xls").Activate
Range("F13").Select
Selection.Copy
Windows("Overhead Display.xls").Activate
Sheets("CHART DISPLAY - FINISH").Activate
Range("U13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Windows("BMW F25 OUTERBELT BLACK.xls").Activate
Range("G13").Select
Selection.Copy
Windows("Overhead Display.xls").Activate
Sheets("CHART DISPLAY - FINISH").Activate
Range("U15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

Windows("BMW F25 OUTERBELT BLACK.xls").Activate
Sheets("RAW DATA LIST").Activate
ActiveSheet.Range("A2") = ""
Windows("BMW F25 OUTERBELT BLACK.xls").Activate

ActiveWorkbook.Close SaveChanges:=False

Windows("Overhead Display.xls").Activate
Sheets("CHART DISPLAY - FINISH").Activate
Range("A1").Select

Application.ScreenUpdating = True
4

2 に答える 2

0

選択はちらつきを引き起こすコマンドの1つです

それ以外の

Range("G13").Select
Selection.Copy

使用する

Range("G13").Copy
于 2012-05-03T20:15:14.773 に答える
0

未テスト

これを試して、エラーが発生した場合は教えてください。

Option Explicit

Sub Sample()
    Dim wbThis As Workbook, WbOther As Workbook
    Dim wsThis As Worksheet

    Application.ScreenUpdating = False

    Set wbThis = ThisWorkbook
    Set wsThis = wbThis.Sheets("CHART DISPLAY - FINISH")

    wsThis.ChartObjects("ChartImage").Delete

    '~~> Change the path as required
    Set WbOther = Workbooks.Open(Filename:="C:\...BLACK.xls")

    With WbOther.Sheets("RYG CHARTS")
        .Visible = True
        .Unprotect Password:="052100F"
        .ChartObjects("Chart 5").ChartArea.Copy
        wsThis.Activate
        ActiveSheet.Paste
    End With

    wbThis.Activate
    'Rename chart to delete later
    ActiveChart.Parent.Name = "ChartImage"
    ActiveSheet.ChartObjects("ChartImage").Activate
    ActiveSheet.Shapes("ChartImage").Top = 100
    ActiveSheet.Shapes("ChartImage").Width = 700
    ActiveSheet.Shapes("ChartImage").Height = 375
    ActiveSheet.Shapes("ChartImage").Left = 20

    With ActiveWindow
        .DisplayGridlines = False
        .DisplayHeadings = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
        .DisplayWorkbookTabs = False
    End With

    With WbOther
        With .Sheets("FILE SETUP")
            '.Unprotect Password:="052100AF"
            wbThis.Range("K2").Value = .Range("J2").Value
            wbThis.Range("J3").Value = .Range("J3").Value
            wbThis.Range("L4").Value = .Range("D2").Value
            wbThis.Range("N3").Value = .Range("D3").Value
            wbThis.Range("U11").Value = .Range("H13").Value
            wbThis.Range("U13").Value = .Range("F13").Value
            wbThis.Range("U15").Value = .Range("G13").Value
        End With

        .Close SaveChanges:=False
    End With

    Application.ScreenUpdating = True
End Sub
于 2012-05-03T20:24:14.473 に答える