Отправить ключи, чтобы отпереть проекта VBA Excel 2013

Question

Отправить ключи, чтобы разблокировать VBA проект

Любой Я несколько продвинуты в макро письменной форме, однако это все-самоучка от этого сайта, и я не в полной мере понять большое изображение

Я пытаюсь создать лист распространения Excel, который обновит код VBA другого листа распространения Excel, который имеет защищенный паролем проект VBA. Я использую SendKeys для разблокировки проекта VBA. Я также решаю проблему с недостатками SendKey, написав скрипт, чтобы закрыть все открытые документы Excel.

Все код, который я написал работу по своему собственному, но когда я пытаюсь совместить его SendKey макроса размещения пароля в других строках коды:

Это работает:

Sub UnprotectProject() 
With Application 
.SendKeys "%{F11}", True 
.SendKeys "^r", True 
.SendKeys "~", True 
.SendKeys "password", True 
.SendKeys "~", True 
End With 
End Sub 

Это вставляет пароль в другой VBA Код:

Sub UnprotectProject() 
With Application 
.SendKeys "%{F11}", True 
.SendKeys "^r", True 
.SendKeys "~", True 
.SendKeys "password", True 
.SendKeys "~", True 
End With 
Application.VBE.MainWindow.Visible = False 
End Sub 

Обновление:

Бо го набора кода одинаковы, за исключением, следующая строка во втором примере

Application.VBE.MainWindow.Visible = False 

Полный код Я пытаюсь написать пять задач, я создал макрос для каждой задачи, а затем еще один макрос для запуска пять макросов. Каждый макрос выполняет задание при автономном запуске. Однако, когда я пытаюсь запустить макрос, который объединяет отдельные задачи, макрос с send keays терпит неудачу, и вместо разблокировки VBA Project он вставляет пароль в код одного из макросов отдельной задачи. Это пять задач

1. Open (Открыть книгу для изменения)

2. Unprotect VBA Project

3. Обновление VBA код

4. Обновление Рабочий лист

5. SaveAs новая версия

Это макрос я написал для выполнения отдельных задач Sub UsernameCheck()

lastRow = Sheets("update").Range("I" & Rows.count).End(xlUp).Row 
Uname = Environ("Username") 
Set aCell = Sheets("update").Range("I4:I" & lastRow).Find(What:=Uname, MatchCase:=False) 
If aCell Is Nothing Then 
    MsgBox ("Not an Authorised User") 
    Else 
    Open_1 
    UnprotectProject 
    ChangeDateAddUserCheck 
    UpdateDashBoard 
    Save 

End If 

End Sub 

Это код, я использую для редактирования макроса

Sub ChangeDateAddUserCheck() 
    Dim VBComp As VBIDE.VBComponent 
    Dim CodeMod As VBIDE.CodeModule 
    Dim S As String 
    Dim LineNum As Long 

Set VBComp = ActiveWorkbook.VBProject.VBComponents("Module2") 
    'Delete 
    VBComp.CodeModule.DeleteLines 15, 4 
    'add Code 
    Set CodeMod = VBComp.CodeModule 
    LineNum = 15 
    S = "yr = Format(Now(), ""YYYYMMDD"")" & vbCrLf & _ 
     "If UCase(Sheets(""DashBoard"").Range(""B21"").Value) =  UCase(Environ(""Username"")) Then" & vbCrLf & _ 
     "If yr < 20160601 Then B2_Stage Else MsgBox (""Software is Expired"")" & vbCrLf & _ 
     "Else: MsgBox (""Not Authorized User"")" & vbCrLf & _ 
    "End If" 
    CodeMod.InsertLines LineNum, S 
End Sub 

Пароль вставляется в код a Бова между folloing линиями, но я думаю, что имеет больше общего с размещением макроса в редакторе VBA

Dim LineNum As Long 

Set VBComp = ActiveWorkbook.VBProject.VBComponents("Module2") 

Answer 1

Попробуйте это.Намек, для меня, по крайней мере, был комментарий:

[] код для изменения макрос не работает, если они не находятся в той же первенствует экземпляру

Я изменил его дело с различными экземплярами Excel, которые могут быть технически необходимы здесь. В прошлом я наблюдал некоторые неуловимые вещи, используя расширяемость VBE, такие как вставка текста в исполняемый модуль во время выполнения (в основном, что вы описываете).

я ранее заметил некоторые проблемы синхронизации, как «Wait» аргумент SendKeys метода не ждет, поэтому я дополнительно использовать функцию WinAPI Sleep ввести полсекунды задержки после SendKeys вызовов.

Примечание: Вам нужно будет изменить и другие функции, чтобы получить wb Workbook аргумент, явно, и изменить ссылки с ActiveWorkbook на wb и т.д. (Посмотрите, как я изменил ActiveWorkbook.VBProject к wb.VBProject и т.д.)

Option Explicit 
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
Const slp As Long = 500 

Sub Main() 
Dim wb As Workbook 
Dim xlApp As Application 
Call Open_1("C:\debug\stack\protected.xlsm", xlApp, wb) 
Call UnprotectProject(xlApp) 
Call ChangeDateAddUserCheck(wb) 

Set wb = Nothing 
Set xlApp = Nothing 

End Sub 
Sub Open_1(filename$, xlApp As Excel.Application, wb As Workbook) 
    Set xlApp = CreateObject("Excel.Application") 
    Set wb = xlApp.Workbooks.Open(filename) 
    xlApp.Visible = True 
End Sub 

Sub UnprotectProject(xlApp As Object) 

    With xlApp 
     .SendKeys "%{F11}", True 
     Sleep slp 
     .SendKeys "^r", True 
     Sleep slp 
     .SendKeys "~", True 
     Sleep slp 
     .SendKeys "password", True 
     Sleep slp 
     .SendKeys "~", True 
     Sleep slp 
    End With 
End Sub 
Sub ChangeDateAddUserCheck(wb As Workbook) 
    Dim VBComp As Object 'VBIDE.VBComponent 
    Dim CodeMod As Object 'VBIDE.CodeModule 
    Dim S As String 
    Dim LineNum As Long 

Set VBComp = wb.VBProject.VBComponents("Module2") 
    'Delete 
    VBComp.CodeModule.DeleteLines 15, 4 
    'add Code 
    Set CodeMod = VBComp.CodeModule 
    LineNum = 15 
    S = "yr = Format(Now(), ""YYYYMMDD"")" & vbCrLf & _ 
     "If UCase(Sheets(""DashBoard"").Range(""B21"").Value) =  UCase(Environ(""Username"")) Then" & vbCrLf & _ 
     "If yr < 20160601 Then B2_Stage Else MsgBox (""Software is Expired"")" & vbCrLf & _ 
     "Else: MsgBox (""Not Authorized User"")" & vbCrLf & _ 
    "End If" 
    CodeMod.InsertLines LineNum, S 
End Sub 

Pics или не произошло:

Здесь вы можете увидеть, что функция ChangeDateAddUserCheck была введена S код строки в моей книге Protected.xlsm!Module2:

Последующая деятельность:

Я объявил wb и xlApp в Main() подразделам. Затем передайте эти объекты в процедуру Open_1, которая откроет новый Excel и указанный путь к книге.

Тогда любая другая подпрограмма, которая должна работать на этом wb или xlApp объектов (например, ChangeDateAddUserCheck) будет изменено таким образом, что он принимает объект рабочей книги, например:

Sub ChangeDateAddUserCheck(wb As Workbook) 

И также, изменяющей UnprotectProject подписи так, что она принимает xlApp объект:

Sub UnprotectProject(xlApp As Object) 

как бы я ссылаться на горе rkbook, что этот макрос живет

Как и в моем коде, wb распространяется до Main процедуры (так xlApp). Если вам нужны другие процедуры для обработки этих объектов, вы передаете их этим процедурам на приведенные выше примеры. Вы в основном говорите: «[какая-то процедура] теперь возьмет этот объект wb и что-нибудь с ним»