Прошу помочь в след.вопросе: есть макрос (см.ниже), который открывает проводник, находит нужный файл и выделяет его. После выделения нажимаем правой кнопкой, чтобы выбрать последующее действие с предлагаемого списка (например 6-й по списку "Создать ярлык"). Макрос работает, но после выделения он открывает выпадающий список не системы, а Экселя. Как можно прописать так, чтобы выпадающий список выходил именно системы, т.е. как на Рабочем столе мы выделяем какой-нибудь файл и нажимаем на правую кнопку для выбора каких либо действий. [vba]
Код
Sub Файл_лист() Set wb1 = ActiveWorkbook P = wb1.Path On Error Resume Next CreateObject("wscript.shell").Run "explorer.exe /e,/select,""" & P & "\Файл.xlsx" & """", 1, True SendKeys "+{F10}" End Sub
[/vba]
Прошу помочь в след.вопросе: есть макрос (см.ниже), который открывает проводник, находит нужный файл и выделяет его. После выделения нажимаем правой кнопкой, чтобы выбрать последующее действие с предлагаемого списка (например 6-й по списку "Создать ярлык"). Макрос работает, но после выделения он открывает выпадающий список не системы, а Экселя. Как можно прописать так, чтобы выпадающий список выходил именно системы, т.е. как на Рабочем столе мы выделяем какой-нибудь файл и нажимаем на правую кнопку для выбора каких либо действий. [vba]
Код
Sub Файл_лист() Set wb1 = ActiveWorkbook P = wb1.Path On Error Resume Next CreateObject("wscript.shell").Run "explorer.exe /e,/select,""" & P & "\Файл.xlsx" & """", 1, True SendKeys "+{F10}" End Sub
den45444, у меня Ваш макрос работает, меню открывается системное А зачем Вам это меню? Может сразу делать, что нужно? Создавать ярлык можно так: [vba]
Код
Sub t() Dim wshObj As Object Set wb1 = ActiveWorkbook P = wb1.Path Set wshObj = CreateObject("WScript.Shell").CreateShortcut(P & "\ярлык.lnk") wshObj.TargetPath = P & "\Файл.xlsx" wshObj.Save End Sub
[/vba]
den45444, у меня Ваш макрос работает, меню открывается системное А зачем Вам это меню? Может сразу делать, что нужно? Создавать ярлык можно так: [vba]
Код
Sub t() Dim wshObj As Object Set wb1 = ActiveWorkbook P = wb1.Path Set wshObj = CreateObject("WScript.Shell").CreateShortcut(P & "\ярлык.lnk") wshObj.TargetPath = P & "\Файл.xlsx" wshObj.Save End Sub
Manyasha, Благодарю за ответ. Создать ярлык - это просто пример. Вообще, нужно зашифровать или расшифровать файл системным образом. Сейчас при выделении файла и нажатии правой кнопкой выходит список: Открыть, Расположение файла, Печать, Изменить, Зашифровать, Расшифровать и т.п. Вот как раз мне нужны эти функции "Зашифровать и Расшифровать" и они по списку 5 и 6. Можно ли до них добраться?
Manyasha, Благодарю за ответ. Создать ярлык - это просто пример. Вообще, нужно зашифровать или расшифровать файл системным образом. Сейчас при выделении файла и нажатии правой кнопкой выходит список: Открыть, Расположение файла, Печать, Изменить, Зашифровать, Расшифровать и т.п. Вот как раз мне нужны эти функции "Зашифровать и Расшифровать" и они по списку 5 и 6. Можно ли до них добраться?den45444
Скорее всего - система не успевает активировать проводник. Попробуйте добавить паузу: [vba]
Код
Sub Файл_лист() Set wb1 = ActiveWorkbook P = wb1.Path On Error Resume Next CreateObject("wscript.shell").Run "explorer.exe /e,/select,""" & P & "\Файл.xlsx" & """", 1, True Application.Wait (Now + 5 / 86400) SendKeys "+{F10}" End Sub
[/vba] Здесь 5с - для теста - уменьшайте время если нужно. А вообще SendKeys - зло .
Скорее всего - система не успевает активировать проводник. Попробуйте добавить паузу: [vba]
Код
Sub Файл_лист() Set wb1 = ActiveWorkbook P = wb1.Path On Error Resume Next CreateObject("wscript.shell").Run "explorer.exe /e,/select,""" & P & "\Файл.xlsx" & """", 1, True Application.Wait (Now + 5 / 86400) SendKeys "+{F10}" End Sub
[/vba] Здесь 5с - для теста - уменьшайте время если нужно. А вообще SendKeys - зло .SLAVICK
Не знаете ли как выбрать с этого меню 5 или 6-ю строку?
Вам нужно не пункт выбрать а произвести действие так? Вот и нужно искать как зашифровать/расшифровать файл. Посмотрите тут и тут - сильно не вникал в суть, поскольку файлы не шифровал пока.
Не знаете ли как выбрать с этого меню 5 или 6-ю строку?
Вам нужно не пункт выбрать а произвести действие так? Вот и нужно искать как зашифровать/расшифровать файл. Посмотрите тут и тут - сильно не вникал в суть, поскольку файлы не шифровал пока.SLAVICK
SLAVICK, кстати, не знаете как сделать, чтобы SendKeys не выполнялся до того, пока не завершится процесс открывания Проводника?
нет не знаю - поэтому и посоветовал Application.Wait. Вам еще один совет - задавая вопрос - не задавайте конкретному форумчанину. Может кто-то другой знает - он ответит. А так Вы заранее ограничиваете круг помогающих. По поводу:
Option Explicit Declare Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _ ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) _ As Long Public Sub PrintFile(ByVal strPathAndFilename As String) Call apiShellExecute(Application.hwnd, "print", strPathAndFilename, vbNullString, vbNullString, 0) End Sub Sub Test() PrintFile (ActiveWorkbook.Path & "?????.xlsm") End Sub
SLAVICK, кстати, не знаете как сделать, чтобы SendKeys не выполнялся до того, пока не завершится процесс открывания Проводника?
нет не знаю - поэтому и посоветовал Application.Wait. Вам еще один совет - задавая вопрос - не задавайте конкретному форумчанину. Может кто-то другой знает - он ответит. А так Вы заранее ограничиваете круг помогающих. По поводу:
Option Explicit Declare Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _ ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) _ As Long Public Sub PrintFile(ByVal strPathAndFilename As String) Call apiShellExecute(Application.hwnd, "print", strPathAndFilename, vbNullString, vbNullString, 0) End Sub Sub Test() PrintFile (ActiveWorkbook.Path & "?????.xlsm") End Sub
Потому что перед SendKeys надо выполнить AppActivate с именем окна (прямо текст заголовка), в которое будут посланы нажатия клавиш. Если окно еще не появилось, то нужно его подождать в бесконечном цикле с проверкой On Error.
Потому что перед SendKeys надо выполнить AppActivate с именем окна (прямо текст заголовка), в которое будут посланы нажатия клавиш. Если окно еще не появилось, то нужно его подождать в бесконечном цикле с проверкой On Error.
Sub shifr() On Error Resume Next CreateObject("WScript.Shell").Run "explorer.exe /e,/select,""" & ActiveWorkbook.Path & "\Файл.xlsx" & """", 1, True 'открываем проводник (папку) активной книги и выделяем файл под названием "Файл" 'Application.Wait (Now + 3 / 86400) 'Выдерживаем паузу в 3 сек. SendKeys ("+{F10}") 'Нажатие на правую кнопку для вызова системного меню для данного файла SendKeys ("{DOWN 5}") '5 раз нажимаем стрелку вниз SendKeys ("{ENTER}") 'и запускаем End Sub
[/vba]
Хорошо. Вот код: [vba]
Код
Sub shifr() On Error Resume Next CreateObject("WScript.Shell").Run "explorer.exe /e,/select,""" & ActiveWorkbook.Path & "\Файл.xlsx" & """", 1, True 'открываем проводник (папку) активной книги и выделяем файл под названием "Файл" 'Application.Wait (Now + 3 / 86400) 'Выдерживаем паузу в 3 сек. SendKeys ("+{F10}") 'Нажатие на правую кнопку для вызова системного меню для данного файла SendKeys ("{DOWN 5}") '5 раз нажимаем стрелку вниз SendKeys ("{ENTER}") 'и запускаем End Sub
Ну, я что-то соорудил, но это как-то всё очень нестабильно (срабатывает через раз, а то и через два)... Свое "решение" публикую, скорее, как подтверждение того, что я тоже ковырялся по теме. В своей версии, в виду отсутствия у меня в контекстном меню команды шифрования, я просто открываю окно свойств файла (последняя строка в контекстном меню): [vba]
Код
Sub test123()
Dim windowName As String
windowName = Mid(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, "\") + 1) 'заголовок окна - имя папки после последнего слэша
On Error Resume Next Do Err.Clear AppActivate windowName, True 'ожидаем появления нужного окна Loop Until Err = 0 On Error GoTo 0
'DoEvents
AppActivate windowName, True 'и для надёжности еще раз его активируем Application.Wait Now + TimeSerial(0, 0, 3) 'Выдерживаем паузу в 3 сек.
SendKeys "{ESC 5}", True 'несколько нажатий фиктивных клавиш (здесь ни на что не влияют) - типа "на случай непредвиденных потерь из буфера клавиатуры"
Application.Wait Now + TimeSerial(0, 0, 1) SendKeys "+{F10}", True
Application.Wait Now + TimeSerial(0, 0, 1) SendKeys "{UP}", True
Application.Wait Now + TimeSerial(0, 0, 1) SendKeys "{ENTER}", True 'Контекстное меню - Стрелка вверх - "Свойства" файла - открываем
Application.Wait Now + TimeSerial(0, 0, 2)
End Sub
[/vba] ОСОБЫЕ УСЛОВИЯ: 1. перед запуском убедиться в отсутствии других окон Explorer. 2. во время предыдущего запуска Explorer вЫключить отображение области предварительного просмотра (по меню "Упорядочить \ Представление \ Область предпросмотра"). Как показывают тесты, система заметно "отвлекается" на эту область и может непредсказуемо повлиять на очередь нажатий клавиш, посланных SendKeys.
Ну, я что-то соорудил, но это как-то всё очень нестабильно (срабатывает через раз, а то и через два)... Свое "решение" публикую, скорее, как подтверждение того, что я тоже ковырялся по теме. В своей версии, в виду отсутствия у меня в контекстном меню команды шифрования, я просто открываю окно свойств файла (последняя строка в контекстном меню): [vba]
Код
Sub test123()
Dim windowName As String
windowName = Mid(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, "\") + 1) 'заголовок окна - имя папки после последнего слэша
On Error Resume Next Do Err.Clear AppActivate windowName, True 'ожидаем появления нужного окна Loop Until Err = 0 On Error GoTo 0
'DoEvents
AppActivate windowName, True 'и для надёжности еще раз его активируем Application.Wait Now + TimeSerial(0, 0, 3) 'Выдерживаем паузу в 3 сек.
SendKeys "{ESC 5}", True 'несколько нажатий фиктивных клавиш (здесь ни на что не влияют) - типа "на случай непредвиденных потерь из буфера клавиатуры"
Application.Wait Now + TimeSerial(0, 0, 1) SendKeys "+{F10}", True
Application.Wait Now + TimeSerial(0, 0, 1) SendKeys "{UP}", True
Application.Wait Now + TimeSerial(0, 0, 1) SendKeys "{ENTER}", True 'Контекстное меню - Стрелка вверх - "Свойства" файла - открываем
Application.Wait Now + TimeSerial(0, 0, 2)
End Sub
[/vba] ОСОБЫЕ УСЛОВИЯ: 1. перед запуском убедиться в отсутствии других окон Explorer. 2. во время предыдущего запуска Explorer вЫключить отображение области предварительного просмотра (по меню "Упорядочить \ Представление \ Область предпросмотра"). Как показывают тесты, система заметно "отвлекается" на эту область и может непредсказуемо повлиять на очередь нажатий клавиш, посланных SendKeys.Gustav
добавлю: Еще поотключать ВСЕ программы, окна которых могут всплыть в самый неподходящий момент, а также НЕ двигать и НЕ клацать мышью, НЕ нажимать на клавиатуру и вообще лучше не дышать и т.д.... а то мало ли что . В этой шутке лишь доля шутки. Когда используете SendKeys
добавлю: Еще поотключать ВСЕ программы, окна которых могут всплыть в самый неподходящий момент, а также НЕ двигать и НЕ клацать мышью, НЕ нажимать на клавиатуру и вообще лучше не дышать и т.д.... а то мало ли что . В этой шутке лишь доля шутки. Когда используете SendKeys