MyTetra Share
Делитесь знаниями!
Как проверить открыта ли книга?
16.03.2019
23:43
Раздел: !Закладки - VBA - Excell

Как проверить открыта ли книга?

Собственно суть темы отражена в названии. Как при выполнении кода из VBA узнать перед обращением к книге открыта она или нет? Ведь если книга закрыта, то обращение к ней вызовет ошибку, а если открывать без проверки - то это может повлечь за собой утерю данных, если предварительно эта книга не была сохранена. Ни один ни второй вариант, естественно, не устраивают. Я покажу два способа проверки через функции. Если функция вернет True - книга открыта, если False - закрыта. Для проверки функций используем проверочную процедуру Check_Open_Book:

Sub Check_Open_Book() If IsBookOpen("Книга1.xls") Then MsgBox "Книга открыта", vbInformation, "Сообщение" Else MsgBox "Книга закрыта", vbInformation, "Сообщение" 'открываем книгу Workbooks.Open "C:\Книга1.xls" End If End Sub


1

2

3

4

5

6

7

8

9

Sub Check_Open_Book()

    If IsBookOpen("Книга1.xls") Then

        MsgBox "Книга открыта", vbInformation, "Сообщение"

    Else

        MsgBox "Книга закрыта", vbInformation, "Сообщение"

        'открываем книгу

        Workbooks.Open "C:\Книга1.xls"

    End If

End Sub

Данная процедура вызывает функцию IsBookOpen, передавая ей в качестве параметра имя книги, "открытость" которой мы хотим проверить. Я приведу несколько вариантов самой функции IsBookOpen. Во всех вариантах действует один и тот же принцип: код любого из вариантов функции IsBookOpen необходимо скопировать и вставить в стандартный модуль. Модуль должен быть внутри той книги, в кодах которой планируется проверять открыта ли книга. Только тогда IsBookOpen будет доступна для вызова из любого кода этой же книги.
Если вдруг в момент выполнения на строке If IsBookOpen("Книга1.xls") Then появится ошибка "Sub or function not defined" - значит функция
IsBookOpen либо не была скопирована в стандартный модуль, либо она вообще не в стандартном модуле, а в модуле листа, формы или книги.


Вариант 1:

Function IsBookOpen(wbName As String) As Boolean Dim wbBook As Workbook For Each wbBook In Workbooks If wbBook.Name <> ThisWorkbook.Name Then If Windows(wbBook.Name).Visible Then If wbBook.Name = wbName Then IsBookOpen = True: Exit For End If End If Next wbBook End Function


1

2

3

4

5

6

7

8

9

10

Function IsBookOpen(wbName As String) As Boolean

    Dim wbBook As Workbook

    For Each wbBook In Workbooks

        If wbBook.Name <> ThisWorkbook.Name Then

            If Windows(wbBook.Name).Visible Then

                If wbBook.Name = wbName Then IsBookOpen = True: Exit For

            End If

        End If

    Next wbBook

End Function


Функция просматривает все открытые книги и если находит среди них книгу с указанным именем, то функция возвращает True. Есть небольшая особенность - функция исключает скрытые книги(это либо надстройки, либо PERSONAL.XLS). Так же из просмотра исключена та книга, в которой расположен сам код. Если Вам нужно проверить наличие книги независимо от её видимости, то необходимо просто заменить блок

If Windows(wbBook.Name).Visible Then If wbBook.Name = wbName Then IsBookOpen = True: Exit For End If


1

2

3

    If Windows(wbBook.Name).Visible Then

        If wbBook.Name = wbName Then IsBookOpen = True: Exit For

    End If


на одну строку(просто убрать лишнее условие проверки)

If wbBook.Name = wbName Then IsBookOpen = True: Exit For


1

    If wbBook.Name = wbName Then IsBookOpen = True: Exit For



Либо можно использовать Вариант 2:

Function IsBookOpen(wbName As String) As Boolean Dim wbBook As Workbook: On Error Resume Next Set wbBook = Workbooks(wbName) IsBookOpen = Not wbBook Is Nothing End Function


1

2

3

4

5

Function IsBookOpen(wbName As String) As Boolean

    Dim wbBook As Workbook: On Error Resume Next

    Set wbBook = Workbooks(wbName)

    IsBookOpen = Not wbBook Is Nothing

End Function


Данный способ обращается к любой открытой книге, даже если она скрыта как PERSONAL.XLS или надстройка. Однако у данной функции есть недостаток - используется оператор On Error и если в настройках VBA(
Tools -Options -вкладка General) установлено Break on All Errors - то этот код не сработает, если книга не открыта - получим ошибку. В то время как Вариант1 с циклом по всем открытым книгам сработает без ошибок.



Вариант 3:
По просьбам читателей решил добавить код, который проверяет открыта ли книга независимо от её месторасположения и используемого приложения Excel. Книга может быть открыта другим пользователем
(если книга на сервере), в другом экземпляре Excel или в этом же экземпляре Excel.

Function IsBookOpen(wbFullName As String) As Boolean Dim iFF As Integer iFF = FreeFile On Error Resume Next Open wbFullName For Random Access Read Write Lock Read Write As #iFF Close #iFF IsBookOpen = Err End Function


1

2

3

4

5

6

7

8

Function IsBookOpen(wbFullName As String) As Boolean

    Dim iFF As Integer

    iFF = FreeFile

    On Error Resume Next

    Open wbFullName For Random Access Read Write Lock Read Write As #iFF

    Close #iFF

    IsBookOpen = Err

End Function


Функция несколько отличается от приведенных выше - передается в неё не только имя книги, а полный путь к книге, включая имя и расширение:

Sub Test() MsgBox "Файл 'Книга1'" & IIf(IsBookOpen("C:\Книга1.xls"), " уже открыт", " не занят") End Sub


1

2

3

Sub Test()

    MsgBox "Файл 'Книга1'" & IIf(IsBookOpen("C:\Книга1.xls"), " уже открыт", " не занят")

End Sub


Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования