應用程序定義的或對象定義的錯誤（1004） - Excel VBA

Question

我有一個名爲'EvaluationLog.xlsm'的工作簿，我需要將第一個工作表中的特定單元格（不是整行）轉移到另一個名爲'IndicatorLog.xlsm'位於同一目錄中。目標工作表也是第一個。我正在嘗試將宏寄存在'IndicatorLog'工作簿中。

從源每行中的特定細胞，如果在列「O」的內容是「否」，或者如果「j」列的內容是「初始」僅被複制。實際的源數據從第8行開始，目標範圍也從第8行開始。

我有兩個問題。第一個是我在第一行嘗試複製單元格的時候遇到了這個錯誤'應用程序定義或對象定義的錯誤（1004）'。

這是該行：TargetSheet.Range("A" & NRow).Value = WorkBk.ActiveSheet.Range(「A」 & i).Value

的第二個問題是，當我已經有源工作簿打開，我得到一個關於試圖再次打開它，即使我有一個功能，儘量避免警告。 :(

我分配宏表單按鈕任何幫助，將不勝感激:)

這裏有兩個Excel文件：！

Files

下面的代碼：

Sub MergeFromLog() 

Dim TargetSheet As Worksheet 
Dim NRow As Long 
Dim SourceFileName As String 
Dim WorkBk As Workbook 
Dim LastRow As Integer, i As Integer, erow As Integer 

' Set destination file. 
Set TargetSheet = ActiveWorkbook.Worksheets(1) 

' Set source file. 
SourceFileName = ActiveWorkbook.Path & "\2015-2016 Evaluation Log.xlsm" 

' NRow keeps track of where to insert new rows in the destination workbook. 
NRow = 8 

' Open the source workbook in the folder 
If CheckFileIsOpen(SourceFileName) = False Then 
    Set WorkBk = Workbooks.Open(SourceFileName) 
Else 
    Set WorkBk = Workbooks(SourceFileName) 
End If 

LastRow = WorkBk.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 

For i = 8 To LastRow 

    If WorkBk.ActiveSheet.Range("O" & i) = "No" Or WorkBk.ActiveSheet.Range("J" & i) = "Initial" Then 

     ' Copy Student Name 
     TargetSheet.Range("A" & NRow).Value = WorkBk.ActiveSheet.Range(「A」 & i).Value 
     ' Copy DOB 
     TargetSheet.Range("B" & NRow).Value = WorkBk.ActiveSheet.Range(「C」 & i).Value 
     ' Copy ID# 
     TargetSheet.Range("C" & NRow).Value = WorkBk.ActiveSheet.Range(「D」 & i).Value 
     ' Copy Consent Day 
     TargetSheet.Range("D" & NRow).Value = WorkBk.ActiveSheet.Range(「L」 & i).Value 
     ' Copy Report Day 
     TargetSheet.Range("E" & NRow).Value = WorkBk.ActiveSheet.Range(「N」 & i).Value 
     ' Copy FIE within District Timelines? 
     TargetSheet.Range("F" & NRow).Value = WorkBk.ActiveSheet.Range(「O」 & i).Value 
     ' Copy Qualified? 
     TargetSheet.Range("H" & NRow).Value = WorkBk.ActiveSheet.Range(「A」 & i).Value 
     ' Copy Primary Eligibility 
     TargetSheet.Range("I" & NRow).Value = WorkBk.ActiveSheet.Range(「U」 & i).Value 
     ' Copy ARD Date 
     TargetSheet.Range("J" & NRow).Value = WorkBk.ActiveSheet.Range(「R」 & i).Value 
     ' Copy ARD within District Timelines? 
     TargetSheet.Range("K" & NRow).Value = WorkBk.ActiveSheet.Range(「S」 & i).Value 
     ' Copy Ethnicity 
     TargetSheet.Range("M" & NRow).Value = WorkBk.ActiveSheet.Range(「F」 & i).Value 
     ' Copy Hisp? 
     TargetSheet.Range("N" & NRow).Value = WorkBk.ActiveSheet.Range(「G」 & i).Value 
     ' Copy Diag/LSSP 
     TargetSheet.Range("O" & NRow).Value = WorkBk.ActiveSheet.Range(「X」 & i).Value 

     NRow = NRow + 1 

    End If 

Next i 

End Sub 

Function CheckFileIsOpen(chkSumfile As String) As Boolean 

On Error Resume Next 

CheckFileIsOpen = UCase(Workbooks(chkSumfile).Name) Like UCase(chkSumfile) 

On Error GoTo 0 

End Function 

Answer 1

您可以利用很少使用的帶有錯誤控制的Resume。

Sub MergeFromLog2() 

    Dim SourceSheet As Worksheet, TargetSheet As Worksheet 
    Dim SourceFileName As String 
    Dim LastRow As Long, i As Long, NRow As Long 

    ' Set destination file. 
    Set TargetSheet = ThisWorkbook.Worksheets(1) 
    NRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 

    ' Set source file. 
    On Error GoTo CheckWbIsOpen 
    SourceFileName = ThisWorkbook.Path & "\2015-2016 Evaluation Log.xlsm" 
    'Try to work on it as if it was open. If it is closed an error will be thrown and it will be opened and control will be returned back here 
    Set SourceSheet = Workbooks(Trim(Right(Replace(SourceFileName, "\", Space(99)), 99))).Worksheets(1) 
    On Error GoTo 0 

    With SourceSheet 
     Debug.Print .Name 
     LastRow = .Cells(Rows.Count, "A").End(xlUp).Row 

     For i = 8 To LastRow 
      If .Range("O" & i) = "No" Or .Range("J" & i) = "Initial" Then 

       ' Copy Student Name 
       TargetSheet.Range("A" & NRow).Value = .Range("A" & i).Value 
       ' Copy DOB 
       TargetSheet.Range("B" & NRow).Value = .Range("C" & i).Value 
       ' Copy ID# 
       TargetSheet.Range("C" & NRow).Value = .Range("D" & i).Value 
       ' Copy Consent Day 
       TargetSheet.Range("D" & NRow).Value = .Range("L" & i).Value 
       ' Copy Report Day 
       TargetSheet.Range("E" & NRow).Value = .Range("N" & i).Value 
       ' Copy FIE within District Timelines? 
       TargetSheet.Range("F" & NRow).Value = .Range("O" & i).Value 
       ' Copy Qualified? 
       TargetSheet.Range("H" & NRow).Value = .Range("A" & i).Value 
       ' Copy Primary Eligibility 
       TargetSheet.Range("I" & NRow).Value = .Range("U" & i).Value 
       ' Copy ARD Date 
       TargetSheet.Range("J" & NRow).Value = .Range("R" & i).Value 
       ' Copy ARD within District Timelines? 
       TargetSheet.Range("K" & NRow).Value = .Range("S" & i).Value 
       ' Copy Ethnicity 
       TargetSheet.Range("M" & NRow).Value = .Range("F" & i).Value 
       ' Copy Hisp? 
       TargetSheet.Range("N" & NRow).Value = .Range("G" & i).Value 
       ' Copy Diag/LSSP 
       TargetSheet.Range("O" & NRow).Value = .Range("X" & i).Value 

       NRow = NRow + 1 

      End If 

     Next i 
     Application.DisplayAlerts = False 
     .Parent.Close False 
    End With 

    GoTo Safe_Exit 
CheckWbIsOpen: 
    i = i + 1 
    If i > 1 Then 
     'tried once and failed - do not keep trying to open something that doesn't want to be opened 
     Debug.Print "Unable to open: " & SourceFileName 
     Exit Sub 
    End If 
    Workbooks.Open Filename:=SourceFileName, ReadOnly:=True 
    Resume '<- this sends control back to the line that threw the error 
Safe_Exit: 
    Set SourceSheet = Nothing 
    Set TargetSheet = Nothing 
    Application.DisplayAlerts = True 
End Sub 

與Resume錯誤捕獲完全否定您的功能的需要。

Answer 2

更改函數調用：

Function CheckFileIsOpen(chkSumfile As String) As Boolean 
Dim ret 
ret = False 
On Error Resume Next 

ret = (Workbooks(chkSumfile).Name <> "") 

CheckFileIsOpen = ret 

End Function 

否則，具有諷刺意味的命名智能引號起不到很好的（或者，他們根本就不工作）用VBA。修復那些正常的引號應該照顧它。