Как проверить открыта ли книга Excel
Функция КНИГАОТКРЫТА проверяет открыта ли книга Excel и возвращает ИСТИНА если указанный файл открыт и ЛОЖЬ в противном случае.
Описание функции
Функция =КНИГАОТКРЫТА(ИМЯ) определяет открыта ли заданная книга или нет. Если книга с указанным именем открыта, то функция возвратит значение ИСТИНА, если книга закрыта, то ЛОЖЬ. Функция имеет только один аргумент:
- ИМЯ — название книги Excel (вместе с расширением), открытие которой необходимо проверить.
Практический смысл данной функции, для непосредственного применения ее в ячейке небольшой. Больше полезен ее код на VBA (он ниже), с помощью которого можно выполнять проверку открытия перед выполнением каких-либо операций.
Пример
Пример проверки открытия книги.
Код на VBA
Function КНИГАОТКРЫТА(ИМЯ As String) As Boolean Dim Wb As Workbook On Error Resume Next Set Wb = Workbooks(ИМЯ) If Err.Number = 0 Then КНИГАОТКРЫТА = True End Function
Надстройка
VBA-Excel
Надстройка для Excel содержит большой набор полезных функций, с помощью которых вы значительно сократите время и увеличите скорость работы с программой.
Как проверить открыта ли книга excel в vba
> Хочется вместо системного сообщения и прекращения работы макроса
Почему бы не перехватить ошибку? On Error.
Пользователь
Сообщений: 1220 Регистрация: 13.05.2010
25.11.2010 15:47:16
Сергей, недавно подымалась тема с Вашим вопросом, наберите в поиске «UserStatus» (код от уважаемого The_Prist).
Пользователь
Сообщений: 2746 Регистрация: 22.12.2012
На лицо ужасный, добрый внутри
25.11.2010 15:53:56
Что-то я не понял.
Вы что хотите:
1. Не открывая книгу, узнать, не открыта ли она в режиме монопольного доступа кем-то другим?
2. Узнать программно, кем, когда и в каком режиме открыта книга общего доступа?
В любом случае посмотрите, может быть что-нибудь наковыряете для себя из этого:
Sub Workbook_UserStatus ()
‘Свойство UserStatus Property возвращает 2D-массив (1 to 3), содержащий информацию _
о каждом пользователе, открывшем книгу в режиме общего доступа.
‘1-й столбец — имя пользователя, открывшего книгу в режиме общего доступа, _
2-й столбец — дата и время, когда этот пользователь открыл книгу, _
3-й столбец — индикатор режима открытия книги (1 — монопольный, 2 — общий доступ).
Debug.Print IIf(Workbooks(«personal.xls»).UserStatus(1, 3) = 1, «Exclusive», «Shared»)
End Sub
С уважением, Алексей (ИМХО: Excel-2003 — THE BEST. )
25.11.2010 16:09:31
Да, Не открывая книгу, узнать, не открыта ли она (режим «для чтения» не устраивает).
Спасибо за подсказки, щас попробую userstatus
25.11.2010 16:10:55
Почему бы не перехватить ошибку? On Error.
Пробовал, что-то не хочет и всё.
Сообщений: 60940 Регистрация: 14.09.2012
Контакты см. в профиле
25.11.2010 16:13:59
Option Compare Text ‘Если Вы не понимаете, зачем используется эта инструкция, то оставьте её в покое
Private Function WorkbookIsOpen(iName$) As Boolean
‘***********************************************’
‘ Дата создания 01/01/2005
‘ Автор Климов Павел Юрьевич
‘ http://www.msoffice.nm.ru
‘***********************************************’
Dim iBook As Workbook
For Each iBook In Workbooks
If iBook.Name = iName$ Then
WorkbookIsOpen = True
Exit Function
End If
Next
WorkbookIsOpen = False
End Function
Private Function WorkbookIsOpen(iName$) As Boolean
‘***********************************************’
‘ Дата создания 01/01/2005
‘ Автор Климов Павел Юрьевич
‘ http://www.msoffice.nm.ru
‘***********************************************’
Dim iBook As Workbook
For Each iBook In Workbooks
If StrComp(iBook.Name, iName$, vbTextCompare) = 0 Then
WorkbookIsOpen = True
Exit Function
End If
Next
WorkbookIsOpen = False
End Function
Вариант II.
Private Function WorkbookIsOpen(iName$) As Boolean
‘***********************************************’
‘ Дата создания 01/01/2005
‘ Автор Климов Павел Юрьевич
‘ http://www.msoffice.nm.ru
‘***********************************************’
On Error Resume Next
WorkbookIsOpen = IsObject(Workbooks(iName$))
End Function
Private Function WorkbookIsOpen(iName$) As Boolean
On Error Resume Next
WorkbookIsOpen = (TypeOf Workbooks(iName$) Is Workbook)
End Function
Private Function WorkbookIsOpen(iName$) As Boolean
On Error Resume Next
WorkbookIsOpen = (TypeName(Workbooks(iName$)) = «Workbook»)
End Function
Private Function WorkbookIsOpen(iName$) As Boolean
On Error Resume Next
WorkbookIsOpen = (VarType(Workbooks(iName$)) = vbObject)
End Function
Private Function WorkbookIsOpen(iName$) As Boolean
On Error Resume Next
WorkbookIsOpen = Len(Workbooks(iName$).Name) > 0
End Function
Private Function WorkbookIsOpen(iName$) As Boolean
On Error Resume Next
WorkbookIsOpen = Workbooks(iName$).Index > 0
End Function
Пример вызова любой из вышеопубликованных авторских функций :
Private Sub Test()
MsgBox WorkbookIsOpen(«Имя_Книги.xls»)
End Sub
Как проверить открыта ли книга?
Собственно суть темы отражена в названии. Как при выполнении кода из 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
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 либо не была скопирована в стандартный модуль, либо она вообще не в стандартном модуле, а в модуле листа, формы или книги.
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
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
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
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
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, retval As Boolean iFF = FreeFile On Error Resume Next Open wbFullName For Random Access Read Write Lock Read Write As #iFF retval = (Err.Number <> 0) Close #iFF IsBookOpen = retval End Function
Function IsBookOpen(wbFullName As String) As Boolean Dim iFF As Integer, retval As Boolean iFF = FreeFile On Error Resume Next Open wbFullName For Random Access Read Write Lock Read Write As #iFF retval = (Err.Number <> 0) Close #iFF IsBookOpen = retval End Function
Функция несколько отличается от приведенных выше — передается в неё не только имя книги, а полный путь к книге, включая имя и расширение:
Sub Test() MsgBox "Файл 'Книга1'" & IIf(IsBookOpen("C:\Книга1.xls"), " уже открыт", " не занят") End Sub
Sub Test() MsgBox «Файл ‘Книга1′» & IIf(IsBookOpen(«C:\Книга1.xls»), » уже открыт», » не занят») End Sub
Или более близкий к жизненной ситуации вариант: надо открыть книгу, внести в книгу изменения, сохранить и закрыть. Если книга кем-то уже открыта — получим ошибку на этапе сохранения или запрос на этапе открытия. Поэтому сначала проверяем доступность книги и если она доступна — вносим изменения и сохраняем.
Sub Test() Dim sWBFullName As String Dim wb As Workbook 'полный путь к проверяемой книге sWBFullName = "C:\Documents\Книга1.xls" 'если книга кем-то открыта - пропускаем обработку этой книги 'книга закрыта - вносим изменения, сохраняем, закрываем If IsBookOpen(sWBFullName) = False Then Set wb = Application.Workbooks.Open(sWBFullName) 'изменяем значение ячейки "A1" на первом листе книги wb.Sheets(1).Range("A1").Value = "www.excel-vba.ru" ws.Close True End If End Sub
Sub Test() Dim sWBFullName As String Dim wb As Workbook ‘полный путь к проверяемой книге sWBFullName = «C:\Documents\Книга1.xls» ‘если книга кем-то открыта — пропускаем обработку этой книги ‘книга закрыта — вносим изменения, сохраняем, закрываем If IsBookOpen(sWBFullName) = False Then Set wb = Application.Workbooks.Open(sWBFullName) ‘изменяем значение ячейки «A1» на первом листе книги wb.Sheets(1).Range(«A1»).Value = «www.excel-vba.ru» ws.Close True End If End Sub
При использовании функции IsBookOpen так же надо учитывать, что она может посчитать книгу открытой не только если она реально кем-то открыта, а если к ней просто нет доступа(например, заблокирован доступ со стороны администратора и т.п.).
Статья помогла? Поделись ссылкой с друзьями!
Как проверить открыта ли книга excel в vba
Всем доброго дня!
Как можно решить такую задачу:
на сервере находится обще доступный файл («База_Общая»).
При работе со своим локальным файлом («Отчёт») необходимо чтобы макрос проверил — открыта ли «База_Общая»? Если открыта кем-то другим — прекратить работу макроса. Если не открыт никем — открыть и перейти к этой самой «Базе_Общей». Если открыта у меня — просто перейти к нему.
Нашёл такое решение.
[vba]
Sub Macro1
Dim strFileName As String
strFileName = «Q:\База данных\База_Общая.xlsm»
If Not FileLocked(strFileName) Then
Workbooks.Open strFileName
Else: Exit Sub
End If
End Sub
Function FileLocked(strFileName As String) As Boolean
On Error Resume Next
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
If Err.Number <> 0 Then
MsgBox «Файл » & strFileName & » уже у кого-то открыт», vbInformation
FileLocked = True
Err.Clear
End If
End Function
Но не работает как надо, если файл открыт у меня.
Что надо исправить?
Всем доброго дня!
Как можно решить такую задачу:
на сервере находится обще доступный файл («База_Общая»).
При работе со своим локальным файлом («Отчёт») необходимо чтобы макрос проверил — открыта ли «База_Общая»? Если открыта кем-то другим — прекратить работу макроса. Если не открыт никем — открыть и перейти к этой самой «Базе_Общей». Если открыта у меня — просто перейти к нему.
Нашёл такое решение.
[vba]
Sub Macro1
Dim strFileName As String
strFileName = «Q:\База данных\База_Общая.xlsm»
If Not FileLocked(strFileName) Then
Workbooks.Open strFileName
Else: Exit Sub
End If
End Sub
Function FileLocked(strFileName As String) As Boolean
On Error Resume Next
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
If Err.Number <> 0 Then
MsgBox «Файл » & strFileName & » уже у кого-то открыт», vbInformation
FileLocked = True
Err.Clear
End If
End Function
Но не работает как надо, если файл открыт у меня.
Что надо исправить? maverick_77
если нельзя, но очень хочется, то можно!
Сообщение отредактировал maverick_77 — Четверг, 30.07.2015, 17:03
Сообщение Всем доброго дня!
Как можно решить такую задачу:
на сервере находится обще доступный файл («База_Общая»).
При работе со своим локальным файлом («Отчёт») необходимо чтобы макрос проверил — открыта ли «База_Общая»? Если открыта кем-то другим — прекратить работу макроса. Если не открыт никем — открыть и перейти к этой самой «Базе_Общей». Если открыта у меня — просто перейти к нему.
Нашёл такое решение.
[vba]
Sub Macro1
Dim strFileName As String
strFileName = «Q:\База данных\База_Общая.xlsm»
If Not FileLocked(strFileName) Then
Workbooks.Open strFileName
Else: Exit Sub
End If
End Sub
Function FileLocked(strFileName As String) As Boolean
On Error Resume Next
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
If Err.Number <> 0 Then
MsgBox «Файл » & strFileName & » уже у кого-то открыт», vbInformation
FileLocked = True
Err.Clear
End If
End Function
Но не работает как надо, если файл открыт у меня.
Что надо исправить? Автор — maverick_77
Дата добавления — 30.07.2015 в 17:01