工作簿.在特定情况下打开失败



所以我在我的项目中有一个函数,用于查找工作簿,检查它是否打开,如果工作簿已关闭,则打开该工作簿。

Public Function CheckOpen(wbName As String)
Dim wb As Workbook
Dim Ret_type As Integer
Dim strMsg As String
Dim strTitle As String
Dim tempstr As String
Dim x As Integer, y As Integer
On Error Resume Next
Set wb = Application.Workbooks(wbName)
On Error GoTo 0
strTitle = "Workbook Not Open"
strMsg = "Workbook " + wbName + " isn't open, press 'Retry' to fix."
If wb Is Nothing Then
'The workbook isn't open
Ret_type = MsgBox(strMsg, vbRetryCancel + vbQuestion, strTitle)
Select Case Ret_type
Case 4
'Retry Case
On Error Resume Next
For x = 1 To 2
For y = 1 To 2
Workbooks.Open (FindFilePath(x) + FileEndingManager(wbName, y))
Debug.Print (FindFilePath(x) + FileEndingManager(wbName, y))
Next y
Next x
Case 2
'Cancel Case
MsgBox "You clicked 'CANCEL' button."
End Select
End If
End Sub

澄清一下:直接调用此函数时有效。如:

Sub TestCheck()
Call CheckOpen("WorkbookName")
End Sub

没关系。一切正常。但是,当我从实际电子表格中输入的函数调用此函数时,会出现 MsgBox,但它永远不会打开所需的工作簿。

我不明白发生了什么。

Using Functions (UDF)

如评论中所述@jkpieterse

从单元格调用的函数不能执行打开工作簿等操作

函数能够像Excel的内置函数一样从单元格调用,并且它们始终向单元格返回某些内容(即使它只是一个错误)。

对于一个函数要返回一些东西,除了错误之外,它必须有一行,比如

FunctionName = *a value that complies with the function declaration*

函数在 Excel 中以自动完成功能提供,即使它们返回#VALUE!错误,如果未按上述方式设置返回,也会发生该错误。 这可能会让用户感到沮丧!

UDF 中的任何其他错误也会导致#VALUE!错误,找到它们的唯一方法是使用 F8 单步执行函数。 它们在编译时不显示!

因此,至少有 2 个理由不使用 sub 就足够了的函数。

如果要更改任何书籍或工作表对象,请声明 Sub过程。

谨慎使用 UDF!

要回答您的问题:

我尝试将您的代码重构为工作表可调用函数,该函数将在使用变量的同时与 Sub 过程一起使用。

我不知道FindFilePath(x)FileEndingManager(wbName, Y)做什么,所以假设它们确实有效。

Public Function CheckOpen(wbName As String) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Application.Workbooks(wbName)
On Error GoTo 0
If Not wb Is Nothing Then
CheckOpen = True 'the essence of a "Function" - it returns a value!
End If
End Function

或者,您可以使用这个不需要On Error Resume Next的替代函数

Public Function CheckOpen1(wbName As String) As Boolean
Dim wb As Workbook
For Each wb In Workbooks 'in all the workbooks you have open
If wb.Name = wbName Then
CheckOpen = True 'if not, CheckOpen will remain FALSE
End If
Next
End Function 

然后,您的子过程如下所示:

FileEndingManager(wbName, y)
Sub TestCheck()
Dim Ret_type As Integer
Dim strMsg As String
Dim strTitle As String
Dim tempstr As String
Dim x As Integer, y As Integer

If Not CheckOpen("WorkbookName") Then
strTitle = "Workbook Not Open"
strMsg = "WorkbookName isn't open, press 'Retry' to fix."
Ret_type = MsgBox(strMsg, vbRetryCancel + vbQuestion, strTitle)

Select Case Ret_type
Case 4
'Retry Case
On Error Resume Next
For x = 1 To 2
For y = 1 To 2
Workbooks.Open (FindFilePath(x) + FileEndingManager(wbName, y))
Debug.Print (FindFilePath(x) + FileEndingManager(wbName, y))
Next y
Next x
On Error GoTo 0 'end the Resume Next ASAP
'Check if the x, y loop has opened WorkbookName
If Not CheckOpen("WorkbookName") Then 'probably can't be opened
strMsg = "WorkbookName can't be opened! Clicking OK will exit sub."
MsgBox strMsg, vbCritical, strTitle
Exit Sub
End If
Case 2 'Tell user something they know! Not necessary
'Cancel Case
MsgBox "You clicked 'CANCEL' button." 'delete this line and just exit
Exit Sub
End Select
End If
'Haven't exited yet so safe to proceed
'...do things with WorkbookName
End Sub

最新更新