2012-05-03 106 views
0

私は以下のコードにいくつか問題があります。あるファイルから別のファイルにグラフをコピーして貼り付けてから、グラフが来たファイルを閉じています。私はデバッガのコードを踏んでいくうちにすべてうまく動作しますが、シート上のボタンを使ってプロシージャを起動すると、エラーが表示されます:オブジェクトが見つかりませんでした。Excel vbaにオブジェクトが見つかりません

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 
+0

このコードを実行しているワークブックの名前は何ですか。 –

+0

オーバーヘッドDisplay.xls – user1096317

+0

グラフを取得するファイルを閉じる行でエラーが発生します。 – user1096317

答えて

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 
+0

オブジェクトはこのプロパティをサポートしていませんまたは方法。行:.ChartObjects( "Chart 5")。ChartArea.Copy wsThis – user1096317

+0

上記のポストを更新する瞬間 –

+0

私もアップデートを試しましたが、同じエラーが表示されます。 – user1096317

0

選択は、コマンドのいずれかが

Range("G13").Select 
Selection.Copy 

使用の

代わりフリッカの原因となっている

Range("G13").Copy 
+0

まだちらつきがたくさんあります。 – user1096317

+0

activateは、フリッカーも作成します。例えば、このすべて ** ActiveSheet.ChartObjects( "図表5")。 ActiveChart.ChartArea.Select ActiveChart.ChartArea.Copy ** ** ActiveSheet.ChartObjectsことができます( "表5")。コピーをアクティブ化** – SeanC

+0

OKですが、Application.ScreenUpdating = Falseを使用すると画面が更新されないと思ったのですか? – user1096317

関連する問題