几天前我使用了这个宏,并且一切正常,但是现在无法正常工作。我在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
答案 0 :(得分:1)
如果使用Range.Find method,可能是找不到任何内容,因此您将始终需要测试这种情况。
您始终需要 将LookAt
的{{1}}参数指定为Find
或xlWhole
,否则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)