Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Запрет сохранения книги до выполнения условия "заполнить последнюю ячейку, если заполнена соседняя ячейка", Запрет сохранения книги макросом
 
Здравствуйте,

Столкнулся с такой задачей. Можно ли создать макрос, чтобы книга не закрывалась до выполнения условия "заполнить последнюю ячейку, если заполнена соседняя ячейка". Допустим на "Листе 1" Строка "А6" заполнена. Надо чтобы строка "B6" тоже была заполнена и только после этого можно было закрыть книгу. И так далее...

П.С. Я нашёл что то подобное https://excelpedia.ru/makrosi-v-excel/ne-daem-zakrit-knigu, но тут говорится об определённом ячейке.
Изменено: Шахин - 17 Янв 2020 11:26:53
 
Шахин,
попробуйте так
Скрытый текст
 
Mershik, Работает :idea: , только вот когда книга закрывается, остаётся значок excel активным.
Изменено: Шахин - 17 Янв 2020 12:44:09
 
Шахин, ну я не в курсе я просто переделал макрос предложенный по ссылке, может кто то помжет этот косяк исправить
 
Mershik, Спасибо большое и на этом! ) :D  :idea:  Респект!
 
Подправил макрос уважаемого Mershik. Добавил функцию закрытия приложения если открыта одна книга. Добавил проверку если В заполнен, а А не заполнен. Не совсем понял зачем сохранять книгу ну да ладно.
Код
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i&, lLastRow&
Dim K1$, K2$
'Шаг 1: Проверяем пустая ли ячейка C7
i = 4
With Worksheets("Лист 1")
    lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    K1 = .Range("A" & i & ":A" & lLastRow).Address
    K1 = Application.WorksheetFunction.CountIf(Range(K1), "<>" & "")
    lLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
    K2 = .Range("B" & i & ":B" & lLastRow).Address
    K2 = Application.WorksheetFunction.CountIf(Range(K2), "<>" & "")
End With
'Шаг 2: Если пустая, отменить закрытие книги
If K1 <> K2 Then
    Cancel = True
    MsgBox "При заполненных ячейках в столбца А не может быть пустым значение в столбце В"
    Exit Sub
    'Шаг 3: Если не пустая, сохранить и закрыть
Else
    If Workbooks.Count = 1 Then
        ThisWorkbook.Save
        Application.Quit
    Else
        ThisWorkbook.Save
    End If
End If
End Sub

И ещё один вопрос Mershik: А Вы пробовали через F8 прогнать код? Excel может и загрустить.  :cry:  У меня не раз бывало, что вылетало при таком закрытии.
Знания и технологии принадлежат человечеству, и каждый сам решает делиться ими или исчезнуть вместе с ними.
 
Alemox, вечер добрый, да я только учусь, да я только через f8 все прогоняю иначе не умею пока что   8) , а что то не так получилось в моем варианте ?
Изменено: Mershik - 17 Янв 2020 22:50:38
 
Всё так. Просто процедура на закрытие несколько раз проходит. Может зациклиться в некоторых случаях.  :D
Знания и технологии принадлежат человечеству, и каждый сам решает делиться ими или исчезнуть вместе с ними.
Страницы: 1
Читают тему (гостей: 1)
Наверх