with语句执行错误,但一切正常之前

时间:2019-07-18 10:12:07

标签: excel vba ms-word word-vba

几天前我使用了这个宏,并且一切正常,但是现在无法正常工作。我在with语句的开头出现执行错误,或者遇到另一个自动化错误。

我检查了我的文件是否存在并且存在,检查是否找到了:一切正常,但是当我创建excel对象并以语句开头时出现错误

    ActiveDocument.Application.ScreenUpdating = False

    Dim strSite As Site, intRow As Long, rg As Object, tmp As String, lastCol As Long, i As Long  'varibles pour derniere colonne du fichier excel et la ligne de la trigramme recherche
    Dim xlapp As Object, xlbook As Object, currentcell As Object, nextcell As Object, src As Object
    Dim found As String, filename
    'creation du objet Excel
    On Error Resume Next
    Set xlapp = GetObject(, "Excel.Application")
    If err Then
        Set xlapp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    filename = "FichierTrigrammes.xlsx"
    found = Dir(folderPath & "\" & "FichierTrigrammes.xlsx")
    MsgBox found
    If found <> vbNullString Then

    ' to be changed to the real File Name, if not it will not work
        Set xlbook = xlapp.workbooks.Open(filename:=folderPath & filename): xlapp.Visible = False  'does not open the file, read only => faster to get the info
        ' searching for the Trigramm

        With xlbook.sheets(1)

            intRow = xlbook.sheets(1).Cells.Find(what:=strTrigram).Row 
            'getting the address -> to get the row therafter
            'find the last non blank cell in specific row
            Set currentcell = xlbook.sheets(1).Range("a" & intRow)
            Do While Not IsEmpty(currentcell)
                Set nextcell = currentcell.Offset(0, 1)
                If nextcell.Value = currentcell.Value Then
                    currentcell.EntireRow.Delete
                End If
                Set currentcell = nextcell
            Loop
            lastCol = .Range(currentcell.Address).Column
            For i = 1 To lastCol
                Select Case .Cells(1, i).Value
                    Case "Type Site"
                        strSite.type = .Cells(intRow, i).Value
                    Case "Nom Site"
                        strSite.nomSite = .Cells(intRow, i).Value
                End Select
            Next i
        End With

       'Set xlapp = Nothing: Set xlbook = Nothing                        ' pour ne pas sauvegarder le document
    End If
    ActiveDocument.Application.ScreenUpdating = True
    getSiteInfo = strSite
End Function

1 个答案:

答案 0 :(得分:1)

第一期

  1. 如果使用Range.Find method,可能是找不到任何内容,因此您将始终需要测试这种情况。

  2. 您始终需要 LookAt的{​​{1}}参数指定为FindxlWhole,否则VBA将使用任何用户或之前使用的VBA(没有默认值)。如果不指定它,那么您将永远不知道得到什么。

是这样的:

xlPart

如果您在Word中使用Dim FoundAt As Range '… FoundAt = xlbook.sheets(1).Cells.Find(What:=strTrigram, LookAt:=xlWhole) If Not FoundAt Is Nothing Then ' intRow = FoundAt.Row 'All your other code Else MsgBox "'" & strTrigram & "' was not found." End If ,请定义以下常量:

Late Binding

使它们在Word中可用。


第二期

请注意,使用以下代码,两个Const xlWhole As Long = 1 Const xlPart As Long = 2 都可能失败,并且由于Set xlapp这两个错误都将被隐藏。

On Error Resume Next

将其更改为

On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If err Then
    Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0

第三期

您测试On Error Resume Next Set xlapp = GetObject(, "Excel.Application") On Error GoTo 0 If xlapp Is Nothing Then Set xlapp = CreateObject("Excel.Application") End If 是否存在,但是您打开了其他folderPath & "\" & "FichierTrigrammes.xlsx"

将其更改为

folderPath & filename

并使用它打开文件

filename = "FichierTrigrammes.xlsx"
found = Dir(folderPath & Application.PathSeparator & filename)