Question

我的目标是弹出一个消息框“该文件已打开到另一个工作簿，请关闭它”

问题是我试图检测文件名表是否已打开到另一个工作簿。

我尝试对其进行编码，但是我只会检测文件名是否已打开给我使用的工作簿。

Public Sub MainDelete()    
    xRet = IsWorkBookOpen(currentName & ".xlsx")
    If t_int_fc.FolderExists(SuperFinalmyPath & "\検査資料（PH→DTJP）\塗りつぶし結果\PH塗り潰し結果\セルフ結果\Tool②_Output(Delete)\") = True Then
        If xRet Then
            Call Warnings(7)
            CheckOpen = True
        Else                      
            CheckOpen = False
        End If
    Else
       'Do nothing
    End If  
End Sub


Function IsWorkBookOpen(Name As String) As Boolean
    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (Not xWb Is Nothing)
End Function


Public Sub Warnings(Num As Integer)
    Select Case Num
        Case 1
            MsgBox "入力 Section is not existing"
        Case 2
            MsgBox "理論 Section is not existing"
        Case 3
            MsgBox "Incorrect Placement of 入力値 Section"
        Case 4
            MsgBox "Incorrect Placement of 理論値 Section"
        Case 5
            MsgBox "No Target(対象) Items"
        Case 6
            MsgBox "Inspection sheet must be located in 「検査結果」folder"
        Case 7
            MsgBox "Generated file is already open! Please close it first."

    End Select
End Sub

Answer 1

如果您要在帖子中检查打开的工作簿中是否存在某个工作表，则可以测试以下代码中的内容：

Public Sub MainDelete()

Dim currentName As String
Dim ShtName As String

ShtName = "Sheet1" ' <-- change "Sheet1" to your sheet name

' ~~~ call Function and pass the Workbook name and Worksheet name
xRet = IsWorksheetOpen(currentName & ".xlsx", ShtName)

' rest of your code

End Sub

'=================================================================

Function IsWorksheetOpen(WBName As String, WShtName As String) As Boolean

    Dim xWb As Workbook
    Dim xSht As Worksheet

    On Error Resume Next
    Set xWb = Application.Workbooks(Name)
    On Error GoTo 0
    If Not xWb Is Nothing Then
        On Error Resume Next
        ' check also if worksheet is found in Workbook
        Set xSht = xWb.Worksheets(WShtName)
        On Error GoTo 0
        If Not xSht Is Nothing Then ' sheet exists
            IsWorksheetOpen = True
        Else
            IsWorksheetOpen = False
        End If
    Else
        IsWorksheetOpen = False
    End If

End Function

Answer 2

检查例如如果工作簿已经被网络中的另一台计算机或另一个Excel实例打开，请使用以下命令：

Function isFileOpen(filename As String) As Boolean
    Dim fileNum As Integer
    Dim errNum As Integer

    On Error Resume Next
        fileNum = FreeFile()

        Open filename For Input Lock Read As #fileNum
        Close fileNum

        errNum = Err
    On Error GoTo 0

    Select Case errNum
        Case 0  'No error
            isFileOpen = False

        Case 70 'Permission denied
            isFileOpen = True

        Case Else
            Error errNum
    End Select
End Function

https://support.microsoft.com/en-us/help/291295/macro-code-to-check-whether-a-file-is-already-open

我怎么知道我的工作表是否也打开了另一个工作簿

2 个答案: