Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Необходимо проверить открыта ли книга - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Необходимо проверить открыта ли книга (Макросы/Sub)
Необходимо проверить открыта ли книга
maverick_77 Дата: Четверг, 30.07.2015, 17:01 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 39
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
Всем доброго дня!
Как можно решить такую задачу:
на сервере находится обще доступный файл ("База_Общая").
При работе со своим локальным файлом ("Отчёт") необходимо чтобы макрос проверил - открыта ли "База_Общая"? Если открыта кем-то другим - прекратить работу макроса. Если не открыт никем - открыть и перейти к этой самой "Базе_Общей". Если открыта у меня - просто перейти к нему.

Нашёл такое решение.
[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
[/vba]
[vba]
Код
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]

Но не работает как надо, если файл открыт у меня.
Что надо исправить?


если нельзя, но очень хочется, то можно!

Сообщение отредактировал 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
[/vba]
[vba]
Код
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]

Но не работает как надо, если файл открыт у меня.
Что надо исправить?

Автор - maverick_77
Дата добавления - 30.07.2015 в 17:01
Roman777 Дата: Четверг, 30.07.2015, 17:16 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
maverick_77,
попробуйте так:
[vba]
Код
Sub Macro1
      Dim strFileName As String
      strFileName = "Q:\База данных\База_Общая.xlsm"
      If IsBookOpen(strFileName) = false Then
      Workbooks.Open strFileName
      Else: Exit Sub
      End If
End Sub
[/vba]

[vba]
Код
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
[/vba]
Взято отсюдаль:
http://www.excel-vba.ru/chto-um....i-kniga


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Четверг, 30.07.2015, 17:18
 
Ответить
Сообщениеmaverick_77,
попробуйте так:
[vba]
Код
Sub Macro1
      Dim strFileName As String
      strFileName = "Q:\База данных\База_Общая.xlsm"
      If IsBookOpen(strFileName) = false Then
      Workbooks.Open strFileName
      Else: Exit Sub
      End If
End Sub
[/vba]

[vba]
Код
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
[/vba]
Взято отсюдаль:
http://www.excel-vba.ru/chto-um....i-kniga

Автор - Roman777
Дата добавления - 30.07.2015 в 17:16
RAN Дата: Четверг, 30.07.2015, 17:24 | Сообщение № 3
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
Sub Macro1
     Dim strFileName As String
     strFileName = "Q:\База данных\База_Общая.xlsm"
For Each wbBook In Workbooks
         If wbBook.FullName = strFileName  Then exit sub
Next
     If Not FileLocked(strFileName) Then
     Workbooks.Open strFileName
     Else: Exit Sub
     End If
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
Sub Macro1
     Dim strFileName As String
     strFileName = "Q:\База данных\База_Общая.xlsm"
For Each wbBook In Workbooks
         If wbBook.FullName = strFileName  Then exit sub
Next
     If Not FileLocked(strFileName) Then
     Workbooks.Open strFileName
     Else: Exit Sub
     End If
End Sub
[/vba]

Автор - RAN
Дата добавления - 30.07.2015 в 17:24
KSV Дата: Четверг, 30.07.2015, 17:29 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 770
Репутация: 255 ±
Замечаний: 0% ±

Excel 2013
Добрый день!
Можно так
К сообщению приложен файл: 5784492.xls (27.5 Kb)


KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333
 
Ответить
СообщениеДобрый день!
Можно так

Автор - KSV
Дата добавления - 30.07.2015 в 17:29
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Необходимо проверить открыта ли книга (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!