发送密钥以解锁 VBA 项目 Excel 2013

Question

发送密钥解锁 VBA 项目

任何我在宏编写方面有点高级，但是都是在这个网站上自学的，我并不完全了解大局

我正在尝试创建一个 Excel 传播 sheet，它将更新另一个 Excel 传播 sheet 的 VBA 代码，该传播 sheet 有密码保护VBA 项目。我正在使用 SendKeys 解锁 VBA 项目。我还通过编写脚本来关闭所有打开的 excel 文档来解决 SendKey 缺陷。

我编写的所有代码都可以独立运行，但是当我尝试组合它们时，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

我尝试编写的完整代码有五个任务，我为每个任务创建了一个宏，然后另一个宏运行这五个宏。每个宏在运行时独立完成预期的工作。但是，当我尝试运行组合单个任务的宏时，带有发送键的宏失败了，它没有解锁 VBA 项目，而是将密码粘贴在单个任务之一的代码中宏指令这是五个任务

打开（打开要更改的工作簿）
取消保护 VBA 项目
更新VBA代码
更新作品sheet
另存为新版本

这是我写给运行个别任务的宏子用户名检查()

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

密码被粘贴在上面代码中的以下几行之间，但我认为这与宏在 VBA 编辑器

中的位置有更多关系

Dim LineNum As Long

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

Answer 1

试试这个。至少对我来说，提示在您的评论中：

[the] code for changing a macro doesn't work unless they are in the same excel instance

我对其进行了修改以处理 Excel 的不同实例，这在技术上可能是必要的。我在过去使用 VBE 扩展性观察到一些奇怪的事情，例如在运行时在执行模块中插入文本（基本上是您所描述的）。

我之前也注意到一些时间问题，因为 SendKeys 方法的 "Wait" 参数没有等待，所以我另外使用 WinAPI Sleep 函数来引入半秒在 SendKeys 次调用后滞后。

注意： 您需要修改其他函数以显式接收 wb 工作簿参数，并将引用从 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

图片或没有发生：

在这里，你可以看到你的函数ChangeDateAddUserCheck已经将S代码串引入到我的工作簿Protected.xlsm!Module2:

后续：

我已经在 Main() 子中声明了 wb 和 xlApp。然后将这些对象传递给 Open_1 过程，该过程将打开新的 Excel 和指定的工作簿路径。

然后，您将修改需要对此 wb 或 xlApp 对象（例如 ChangeDateAddUserCheck）进行操作的任何其他子例程，以便它接受工作簿对象，例如:

Sub ChangeDateAddUserCheck(wb As Workbook)

同样，修改 UnprotectProject 签名，使其接受 xlApp 对象：

Sub UnprotectProject(xlApp As Object)

how would I reference the workbook that this macro is living

在我的代码中，wb 的范围是 Main 过程（xlApp 也是如此）。如果您需要其他过程来处理这些对象，请按照上述示例将它们传递给那些过程。你基本上是在说，“[一些程序] 现在将接受这个 wb 对象并用它做一些事情”

发送密钥以解锁 VBA 项目 Excel 2013

Send Keys to unlock a VBA Project Excel 2013

vba

excel

sendkeys