Страницы: 1 2 След.
RSS
Программное заведение пароля на проект VBA
 
Мое почтение, джентльмены.
Не могу разобрать почему все работает если сохранить и закрыть файл вручную и не работает если сделать программно (раскомментировать две последних строки)?
Excel 2013 x64, Win10
Код
Sub TestPasswordProject()
With ThisWorkbook.Application
.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
.SendKeys "^{TAB}"
.SendKeys "{ }"
.SendKeys "{TAB}" & 1
.SendKeys "{TAB}" & 1
.SendKeys "{TAB}"
.SendKeys "{ENTER}"
End With
'ThisWorkbook.Save ' при ручном сохранении и закрытии файла все сохраняется, программно - нет.
'ThisWorkbook.Close 0
End Sub
«Бритва Оккама» или «Принцип Калашникова»?
 

bedvit Здравствуйте Попробуйте после End With заменить ваши строки на

Код
Application.Wait (Now + TimeValue("00:00:01"))
ThisWorkbook.Close 1

Или так

Код
DoEvents
ThisWorkbook.Close 1

Но интуиция мне подсказывает, что лучше так писать

Код
DoEvents
ThisWorkbook.Close True

Изменено: Евгений Смирнов - 02.02.2022 10:04:25
 
При активации окна проекта сразу становится выделенным дефолтный текст с названием проекта и все SendKeys уже не работают как нужно.
Да, и если бы была активна голова первой вкладки менюшки, то вместо Таб нужна стрелка вправо.
 
Коллеги, вы запускали код?
«Бритва Оккама» или «Принцип Калашникова»?
 

bedvit  Windows XP Excel 2002 и  Excel 2010  32 bit  работает в обоих.

Код
Sub TestPasswordProject()
With ThisWorkbook.Application
.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
.SendKeys "^{TAB}"
.SendKeys "{ }"
.SendKeys "{TAB}" & 1
.SendKeys "{TAB}" & 1
.SendKeys "{TAB}"
.SendKeys "{ENTER}"
End With
DoEvents
ThisWorkbook.Close True
End Sub
 
Евгений Смирнов, окрываете файл и есть защите проекта? Сохраняете и закрываете кодом? Руками ничего не делаете (кроме запуска)?
Изменено: bedvit - 02.02.2022 11:38:27
«Бритва Оккама» или «Принцип Калашникова»?
 
С закомментированными строками работает, а если раскомментировать то нет
 

bedvit Книга2.xls изначально без паролей. Открываю с поддержкой макросов. Нажимаю только кнопку на листе Закрыть книгу. При следующем открытии в VBA стоит пароль «1»

 
Евгений Смирнов, да, так работает. Спасибо.
«Бритва Оккама» или «Принцип Калашникова»?
 
Цитата
bedvit написал:
да, так работает. Спасибо.
А у меня не работает, как не было пароля, так и нет.  :(
 

Msi2102 проверьте доступ к VBA проектам открыт или нет

 
Евгений Смирнов, да открыт, если закомментировать последние строки то пароль ставится, а так нет, возможно не хватает времени на обработку, потому что при закрытии видно, что открытое маленькое окошко, которое закрывается вместе с файлом
 
Msi2102 Попробуйте добавить задержку из первого кода сообщения №2
 
Пробовал, разницы нет
Изменено: Msi2102 - 02.02.2022 15:26:36
 
В ситуации #12 могут помочь несколько последовательных DoEvents перед сохранением книги. Например:
Код
  For i = 1 To 10
    DoEvents
  Next

Если не сработает, попробуйте заменить 10->100, 1000, 10000...
Изменено: sokol92 - 02.02.2022 16:24:05
Владимир
 
Даже так пробовал
Код
Sub TestPasswordProject()
With ThisWorkbook.Application
.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
.SendKeys "^{TAB}"
.SendKeys "{ }"
.SendKeys "{TAB}" & 1
.SendKeys "{TAB}" & 1
.SendKeys "{TAB}"
.SendKeys "{ENTER}"
End With
'DoEvents
'Application.Wait (Now + TimeValue("00:00:02"))
  For i = 1 To 10000
    DoEvents
  Next
ThisWorkbook.Save
  For i = 1 To 10000
    DoEvents
  Next
ThisWorkbook.Close True
End Sub
 
Попробуйте 100000 - у меня это задержка в пару секунд. Какая у Вас версия MS Office, железо?
Владимир
 
Процессор Intel® Core™ i5-9400F CPU @ 2.90GHz   2.90 GHz
Оперативная память 8,00 ГБ
Тип системы 64-разрядная операционная система, процессор x64
Office LTSC
Ставил 100000 все равно не работает
Изменено: Msi2102 - 22.02.2022 20:49:52
 
Цитата
Msi2102 написал:
Office LTSC
Новый офис - новые проблемы.  :)  
Владимир
 
bedvit, возможно только у меня эта проблема, а у остальных все будет норм  :) нужно, чтобы ещё кто-нибудь попробовал
PS: добавил строку перед сохранением, изменения в A1 сохраняет
Код
[a1] = 1
ThisWorkbook.Save
Изменено: Msi2102 - 02.02.2022 19:46:42
 
Доброго Времени суток! Ни Один из кодов не сработал, как был проект без пароля - так и остался без пароля. Даже если закомментировать последние две строчки из первого поста bedvit.
Win_10_Enterp_LTSC_x64, MSO_2019_Pro_Plus, i5 M450 @2,40GHz, RAM 12Gb. (Древний Мамонт)
Изменено: MikeVol - 02.02.2022 20:26:01 (указал разрядность системы)
 

Msi2102  Попробуйте у себя тогда так после End With

Код
DoEvents
ThisWorkbook.Saved = False
ThisWorkbook.Close True
 
Евгений Смирнов, Не срабатывает у меня.
 
Цитата
Евгений Смирнов написал:
Попробуйте у себя тогда так после End With
Уже пробовал, попробовал ещё раз для успокоения души, не сохраняет. Изменения в файле и модуле сохраняет, а пароль не ставит
 
Цитата
bedvit написал:
Коллеги, вы запускали код?
Конечно :) Даже проверил его в пошаговом и обычном режиме. Также проверил окно вылезшее по строке до SendKeys на предмет какие горячие клавиши ответственны за перемещение по полям и вкладкам. О результате этих изысканий и написал выше.
 
Цитата
MikeVol написал:   Win_10_Enterp_LTSC_x64, MSO_2019_Pro_Plus, i5 M450 @2,40GHz, RAM 12Gb. (Древний Мамонт)
У меня Супер свежий Intel Core Duo T2300E, 1666 MHz, Ram 1Гб все 32 bit. Этот код работает.
Может махнемся не глядя компами, пока у меня хорошее настроение. Завтра уже могу не согласиться. :D

Коллеги вывод: Не стоит «сломя голову» менять компы и программное обеспечение, пока ты можешь решать свои задачи на нем, и тебя устраивает время выполнения этих задач. Видимо всегда новое ПО «сырое». Хотя все равно когда то надо обновлять.
 
Цитата
Евгений Смирнов написал:
Супер свежий Intel Core Duo
супер, ну и пусть будет супер. Меня и мой Мамонт устраивает. Не гонюсь за новинкой, всё равно каждый день (возможно) выпускают
Цитата
Евгений Смирнов написал:
Супер свежий
, не вижу смысла. Для работы хватает с головой. Ну а по вопросу этой темы выше написал.
 
Думаю, что на 64-битных системах этот код не заработает :) Думаю, проблема где-то в разном определении хэндлов окон методом SendKeys в 64-битной системе. Одно время даже с API реализацией подобного кода мучался - и там не все гладко в 64-битных системах, как ни странно. Тогда времени уже не хватило докопаться до точных причин и поправить, а потом и вовсе забылось за ненадобностью.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Урррраааааа, заработала!!!!
Вместо ".SendKeys "{ }"" два ".SendKeys "{TAB}"" нужно
Код
Sub TestPasswordProject()
With ThisWorkbook.Application
.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
.SendKeys "^{TAB}"
''''''''''''''''''''''''''''''''''''''
'.SendKeys "{ }"
.SendKeys "{TAB}"
.SendKeys "{TAB}"
''''''''''''''''''''''''''''''''''''''
.SendKeys "{TAB}" & 1
.SendKeys "{TAB}" & 1
.SendKeys "{TAB}"
.SendKeys "{ENTER}"
End With
DoEvents
ThisWorkbook.Close True
End Sub
 
у меня так заработало
P.S. А где применять этот код? )

Код
Sub TestPasswordProject()
    Application.ScreenUpdating = False
    With ThisWorkbook.Application
        .VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
        .SendKeys "^{TAB}"
        .SendKeys "{TAB}"
        .SendKeys "{ }" 'Lock project for viewing
        .SendKeys "{TAB}"
        .SendKeys "{TAB}" & 1 'pass
        .SendKeys "{TAB}" & 1 'pass
        .SendKeys "{TAB}"
        .SendKeys "{ENTER}"
    End With
    DoEvents
    'ThisWorkbook.Close True
    Application.ScreenUpdating = True
End Sub
Изменено: New - 03.02.2022 12:41:52
Страницы: 1 2 След.
Наверх