mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Макрос для снятия защиты листа или книги 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

Комментарии

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

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

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

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

Круто!!!

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

всё супер, снимает. но вот поискал что бы показывал ещё пароль. Нарыл в инете:
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

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

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

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

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

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

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

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

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

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

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

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

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  ____    _       ____    _    __     __   ___  
|___ \ | |__ | __ ) | |_ \ \ / / / _ \
__) | | '_ \ | _ \ | __| \ \ / / | | | |
/ __/ | | | | | |_) | | |_ \ V / | |_| |
|_____| |_| |_| |____/ \__| \_/ \__\_\
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.