Макрос для снятия защиты листа или книги Excel

Макрос предназначен для программного подбора и снятия защиты с листа Excel.

Подобранный пароль не совпадает с установленным - но, тем не менее, защита снимается.

Sub Unlock_Excel_Worksheet()
    t = Timer
    If UnlockSheet(ActiveSheet) Then
        MsgBox "Защита снята. Потребовалось времени: " & Format(Timer - t, "0.0 сек.")
    Else
        MsgBox "Не удалось снять защиту листа", vbCritical
    End If
End Sub

Function UnlockSheet(ByRef sh As Worksheet) As Boolean
    Dim i%, j%, k%, l%, m%, n As Long, i1%, i2%, i3%, i4%, i5%, i6%, txt$
    On Error Resume Next
    For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
    For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
    For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
    For i5 = 65 To 66: For i6 = 65 To 66
        txt$ = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6)
        For n = 32 To 126
            sh.Unprotect txt$ & Chr(n)
            If Err Then
                Err.Clear
            Else
                Debug.Print "Пароль: " & txt$ & Chr(n)
                UnlockSheet = True
                Exit Function
            End If
        Next
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next
End Function

Аналогичный макрос снимает защиту книги Excel:

Sub Unlock_Excel_Workbook() ' снятие защиты книги Excel
    t = Timer
    If UnlockWorkbook(ActiveWorkbook) Then
        MsgBox "Защита снята. Потребовалось времени: " & Format(Timer - t, "0.0 сек.")
    Else
        MsgBox "Не удалось снять защиту книги", vbCritical
    End If
End Sub

Function UnlockWorkbook(ByRef wb As Workbook) As Boolean
    Dim i%, j%, k%, l%, m%, n As Long, i1%, i2%, i3%, i4%, i5%, i6%, txt$
    On Error Resume Next
    For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
    For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
    For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
    For i5 = 65 To 66: For i6 = 65 To 66
        txt$ = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6)
        For n = 32 To 126
            wb.Unprotect txt$ & Chr(n)
            If Err Then
                Err.Clear
            Else
                Debug.Print "Пароль: " & txt$ & Chr(n)
                UnlockWorkbook = True
                Exit Function
            End If
        Next
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next
End Function

119740 просмотров

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Игорь (администратор сайта), 21 Май 2020 - 10:44.#1

Не знаю с чем связано, но иногда макрос подвисает (сам пару раз сталкивался).
Либо отрабатывает менее чем за секунду (и снимает защиту), либо подвисает надолго - видимо, метод Unprotect в каких-то случаях применяется моментально, а в других - какие-то еще действия невидимые вызывает (что занимает в разы больше времени)

Возможно, от версии Excel зависит, но скорее - от конкретного файла Excel, с которого снимается защита
(например, там может запускаться автопересчёт формул при каждой попытке снятия защиты с листа)
Как вариант, - попробуйте отключить автопересчёт формул в файле перед снятием защиты макросом, вдруг поможет.

В любом случае, что есть, то есть. В подавляющем количестве случаев код отрабатывает быстро, и дает нужный результат.
Поскольку я применяю этот макрос примерно раз в год, что-то оптимизировать в коде планов нет.

Кроме того, можете добавить строку кода
DoEvents
после строки
If Err Then
тогда подвисания не будет (но макрос по прежнему будет работать либо очень быстро и результативно, либо долго и безрезультатно)

Гость, 21 Май 2020 - 08:38.#2

Добрый день, несколько лет работало отлично и вот пришли очередные файлы на разбор - и программа зависает на несколько часов и в конце "Не удалось снять защиту книги". Один проход цикла занимает 10 секунд! Эксель 2016, форматы не менялись, вообще вроде бы ничего не изменилось - но больше не работает.

Игорь (администратор сайта), 17 Апр 2019 - 03:17.#3

В большинстве случаев, пароль подбирается за 1-2 секунды. Но иногда подвисает, - если больше 5-10 секунд думает, то можно уже не ждать (снимая задачу excel через диспетчер задач)
Видимо, от версии эксель зависит

Гость, 16 Апр 2019 - 11:22.#4

Создал Макрос предназначен для программного подбора и снятия защиты с листа Excel.
Запустил и зависло причем минут 30 висело и ничего
Версия EXCEL 2016

Энди Дюфрейн, 2 Май 2018 - 10:03.#5

Огонь, пораздолбал все пароли, сотрудники в шоке, сидят косятся... >:)

Игорь, 18 Мар 2018 - 19:33.#6

Потратил полдня, искал как снять защиту структуры книги от изменений. Перепробовал все что угодно, и вот только здесь наконец таки нашел решение проблемы.
Автору РЕСПЕКТ!!

Антон Машкин, 24 Ноя 2017 - 19:48.#7

Добрый день, Николай!

на данной странице макрос для снятия защиты с листов и структуры книги (т.е. защита от добавления или удаления листов в книгу, например). Пароль для открытия книги этим макросом снять нельзя.

Николай, 23 Ноя 2017 - 16:50.#8

Прошу прощения за возможно тупой вопрос, но куда нужно вставить этот макрос?
1) Если в новую книгу - то он ее и пытается взломать (пишет пароль снял)
2) если открываю Excel с паролем на книгу (при открытии МОДАЛЬНОЕ окно), то в код этой книги встроить код не получается (все не активно, пока активно окно "Введите пароль").

Игорь, 19 Сен 2017 - 10:20.#9

Спасибо большое, очень помогла эта программка

Игорь (администратор сайта), 7 Сен 2017 - 20:14.#10

В Excel 2016 всё работает аналогично, зависать не должно

Spongy, 7 Сен 2017 - 17:54.#11

К сожалению, в 16 Excele тоже намертво зависает и не взламывает. Видимо сделали заплатку.

Игорь (администратор сайта), 18 Авг 2017 - 01:40.#12

Перебирайте листы в цикле, внутри цикла активируйте каждый лист, и вызывайте приведенный в статье макрос.
Если сами не справитесь, - можем сделать под заказ (платно)

Гость, 17 Авг 2017 - 13:28.#13

А не подскажете, пожалуйста, макрос, который будет снимать защиту с 3 листов.. только при условии что на 1 листе один пароль, а на 2 и 3 - другой??? Что то не очень получается все правильно сделать:/

Макрос для снятия защиты со всех листов, если пароль одинаковый - знаю. а вот если такая ситуация... не щелкать же каждый лист отдельно(((

Гость, 19 Мар 2017 - 22:54.#14

Офигеть!!!! Ума не приложу как это работает, но блин работает!!!! Огромное спасибо!!!

Serzh, 24 Фев 2017 - 15:27.#15

Спасибо большое. Ваш макрос реально работает!

Александр , 5 Июл 2016 - 15:19.#16

Круто!!!

Сергей, 24 Июн 2016 - 13:37.#17

Спасибо ОГРОМНОЕ!!! Написавшему макрос - 100500 плюсов в Карму!!!

Raikhman, 13 Апр 2016 - 14:25.#18

Пароль не находит. Но защиту с книги снимает. Занятно.

Raikhman, 7 Апр 2016 - 03:41.#19

Единственный пароль - на открытие файла Excel. Остальные пароли снимаются легко без применения макросов. Есть все в интернете.

Пётр, 9 Янв 2016 - 20:18.#20

VBA Password Bypasser. Вот програмка, которая снимает защиту с VBA.

Игорь (администратор сайта), 9 Дек 2015 - 12:44.#21

А для этого есть другие программы и макросы (у меня на сайте нет, - т.к. стабильно работающего решения на VBA нет)

Алексей, 9 Дек 2015 - 12:01.#22

А если стоит пароль и на редактор VBA?

Shepard, 5 Дек 2015 - 02:18.#23

Ребят, защита от редактирования можно снять и без этого. Необходимо открыть документ в Numbers (Mac OS) система от Apple. Сохраняется его снова в exels формате и все =)

Гость, 10 Ноя 2015 - 20:04.#24

Спасибо ребят! Это мегабомбически! :)))

DkNox, 3 Ноя 2015 - 21:30.#25

Спасибо, помогло

Игорь (администратор сайта), 20 Июл 2015 - 13:47.#26

Здравствуйте, Алексей.
Эти макросы предназначены для снятия пароля с листов и пароля на книгу Excel (эти пароли легко снимаются и подбираются)
А в вашем случае стоит пароль на открытие файла, - это совсем другое, ваш пароль никаким макросом не снимается и не взламывается
(там только полным перебором всех возможных вариантов, - что, в общем случае, нереально)

Alexey, 20 Июл 2015 - 12:09.#27

Не смог понять, как применить макрос к книге, которая с паролем. Файл запрашивает пароль и если его не угадал, закрывается. Возможности запустить макрос нет.

Гость, 15 Июл 2015 - 00:09.#28

А Вы попробуйте сами в Excel 2013, хоть со статус-баром, хоть без него, результата не дождетесь.

Игорь (администратор сайта), 13 Июл 2015 - 23:47.#29

А вот если не помещать переменную в статус-бар (что замедляет макрос многократно, в сотни раз) - то среднее время работы макроса составит около 1 секунды...

Гость, 13 Июл 2015 - 22:51.#30

В Excel 2013 макрос работает, но настолько медленно, что дождаться результата нереально. Это наглядно можно увидеть, если поместить переменную txt в статус-бар.

Илья, 9 Апр 2015 - 19:11.#31

Спасибо большое! )

Игорь (администратор сайта), 7 Мар 2015 - 13:21.#32

Возможно, у вас подключены какие-то надстройки в Excel 2013, которые реагируют на этот макрос.
Потому что макрос простейший, и ему без разницы, какая версия Excel - везде одинаково должно работать (не дольше 1-5 секунд)

Гость, 7 Мар 2015 - 01:29.#33

Почему в Excel 2013 не работает макрос?? Намертво зависает. В Excel 2010 работает. Может что-то подправить можно, чтобы в 2013 заработал ??

Гость, 25 Ноя 2014 - 21:23.#34

А в чем заключается физический смысл данного алгоритма?
Почему циклы For i = 65 To 66:
и For n = 32 To 126 ?

Игорь (администратор сайта), 1 Окт 2014 - 13:35.#35

Марина, так в чем проблема?
В статье же есть макрос, снимающий защиту листа

Марина, 1 Окт 2014 - 13:24.#36

Необходимо снять защиту листа

Игорь (администратор сайта), 24 Сен 2014 - 19:51.#37

А вы не обратили внимание, что в вашем макросе есть строка

Debug.Print "Подобран пароль листа: " & str_pass

а в моей версии:

Debug.Print "Пароль: " & txt$ & Chr(n)

Вот это как раз и есть вывод пароля... совсем необязательно было искать другие макросы
А чтобы окошко с паролем выскакивало, - замените Debug.Print на MsgBox

Гость1111111, 24 Сен 2014 - 19:48.#38

всё супер, снимает. но вот поискал что бы показывал ещё пароль. Нарыл в инете:
Sub Подбор_аналога_пароля_листа()
'Макрос написан 20 декабря 2003 года (автор Djon Player).
'Программа предназначена для подбора пароля, для снятия защиты активного листа.

Dim str_pass As String
Dim s As String
Dim ls As Integer
Dim i As Integer
Dim j As Integer
Dim ch As String * 1
Dim found As Boolean
Dim bit0 As String * 1
Dim bit1 As String * 1
Dim kolichestvoBit As Integer

bit0 = "0" 'Символ соотвествующий нулевому биту.
bit1 = "1" 'Символ соотвествующий единичному биту.
kolichestvoBit = 20 'Максимальное количество бит в числе.

s = "" '

ls = Len(s)

While ls < kolichestvoBit

found = False 'Переменная используется как индикатор нахождения очередного двоичного числа.

While Not found
For i = ls To 1 Step -1
ch = Mid(s, i, 1)
If ch = 0 Then
Mid(s, i, 1) = bit1
For j = i + 1 To ls
Mid(s, j, 1) = bit0
Next j
found = True
Exit For
End If
Next i
If Not found Then
s = bit0 & s
ls = ls + 1
found = True
End If

Wend

str_pass = s 'Строка, в которой формируется число в двоичном представлении.

On Error Resume Next

ActiveSheet.Unprotect Password:=str_pass 'Попытка снятия защиты листа.

If Err.Number <> 0 Then
Err.Clear 'Очистить ошибку.
Else
MsgBox "Подобран пароль листа: " & str_pass
Debug.Print "Подобран пароль листа: " & str_pass
Exit Sub
End If

Wend

On Error GoTo 0

End Sub

Наталья, 8 Авг 2014 - 13:14.#39

Спасибо, выручили! Коллега случайно поставила пароль на книгу, а какой - не запомнила.

Гость, 7 Авг 2014 - 15:43.#40

Спасибо !!! все работает в лучшем виде =)

Игорь (администратор сайта), 30 Июн 2014 - 14:57.#41

Здравствуйте, Геннадий.
Защита книги снимается аналогично.
Добавил соответствующий макрос в статью.

Геннадий, 30 Июн 2014 - 13:23.#42

А для снятия пароля книги макрос есть?

Морячок, 26 Июн 2014 - 19:15.#43

Огромное спасибо!!! Безотказно, как автомат Калашникова ;)

Гость, 13 Май 2014 - 23:50.#44

Спасибо, всё чётко.

Гость, 8 Апр 2014 - 12:22.#45

Good'N'Cool Спасибо, комрад

Анна, 7 Апр 2014 - 13:05.#46

Спасибо большое, сработало!

Гость, 17 Сен 2013 - 00:09.#47

Спасибо! Работает!

Алексей, 19 Июл 2013 - 12:00.#48

ВАХ! ШАЙТАН)))))))
Супер!!!!!!

Макрос для снятия защиты листа или книги Excel

Комментарии

Настройки просмотра комментариев

Отправить комментарий

НАДСТРОЙКИ ДЛЯ EXCEL