VBA打开时,Excel文件不会被填充

时间:2016-02-24 08:54:51

标签: excel vba excel-vba

我正在编写一个代码来打开文件并用源文件填充文件单元格。

我遇到的问题是我的第二个没有填充其细胞。

但是,当文件已经打开时,它可以正常工作。

我添加了一部分代码,让excel在填写第二个文件之前等待几秒钟,但它既不起作用。

有你的想法吗?

代码

Sub RemplirTableaux()

    Dim FilePath$, TargetFilePath$
    Const SheetName$ = "Sheet1"
    FilePath = "file.xlsx"
    TargetFilePath$ = "C:\file.xlsx"

    If Not IsWorkBookOpen(TargetFilePath) Then
        Workbooks.Open (TargetFilePath)
    End If

    Application.Wait DateAdd("s", 5, Now())

    For i = 7 To 23

        If Workbooks(FilePath).Sheets("ACs").Cells(i, "A") = Cells(1, "B") Then

            Workbooks(FilePath).Sheets("ACs").Cells(i, "B").Value = Cells(27, "J")
            Workbooks(FilePath).Sheets("ACs").Cells(i, "C").Value = Cells(27, "K")
            'Another filling statements
        End If
    Next
End Sub

Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
        Case 0:    IsWorkBookOpen = False
        Case 70:   IsWorkBookOpen = True
        Case Else: Error ErrNo
    End Select
End Function

1 个答案:

答案 0 :(得分:2)

您需要正确验证Cells次来电 - 例如:

Sub RemplirTableaux()

    Dim FilePath$, TargetFilePath$
    Dim wb                    As Workbook
    Dim wsSource              As Worksheet
    Const SheetName$ = "Sheet1"

    FilePath = "file.xlsx"
    TargetFilePath$ = "C:\file.xlsx"

    ' change as necessary
    Set wsSource = Workbooks("Tableau.xlsx").Sheets("Some sheet")

    If Not IsWorkBookOpen(TargetFilePath) Then
        Set wb = Workbooks.Open(TargetFilePath)
    End If

    For i = 7 To 23

        With wb.Sheets("ACs")

            If .Cells(i, "A").Value2 = wsSource.Cells(1, "B").Value2 Then
                .Cells(i, "B").Value = wsSource.Cells(27, "J").Value
                .Cells(i, "C").Value = wsSource.Cells(27, "K").Value
                'Another filling statements
            End If

        End With

    Next
End Sub