Excel VBA SendKeys在尝试发送到Excel加载项时不起作用

介绍。 ：在我的公司，我们有一个安装在Excel中的安全加载项，使我们无法在不input所需参数的情况下保存新的Excel工作簿。

挑战 ：使用SendKeys发送这个Excel加载项所需的密钥。

问题 ：当Add-In屏幕popup时（如下面的屏幕截图所示），代码似乎不会继续到下面这行： SendKeys " ", True 。

我的代码 （相关部分）

编辑1 ：下面的代码是在一个For循环，我为每个用户导出一个过滤数据库给该用户。 所以每次我尝试为其中一个用户保存一个文件时，我将遇到加载项（我需要在For循环中“旁路”它）。

 ' sort the PM's workbook , hide source data Application.DisplayAlerts = False NewWB.Sheets("Combined").Visible = False NewWB.Sheets("Sheet3").Delete NewWB.SaveAs "Budget usage - " & Year(Date) & "-" & Month(Date - 30) & " " & PMList(r) Dim i As Long SendKeys " ", True ' <-- it doesn't get to this line when the Excel Add-In pops up For i = 1 To 3 SendKeys "+{DOWN}", True Next i SendKeys "{ENTER}", True For i = 1 To 4 SendKeys "+", True Next i SendKeys "{ENTER}", True 

Answer 1

 Public Sub TryMe() Dim s As String Dim sPath As String Dim sTitle As String: sTitle = "runme.vbs" s = "Set WshShell = WScript.CreateObject(""WScript.Shell"")" & vbNewLine & _ "WScript.Sleep 6000" & vbNewLine & _ "WshShell.SendKeys ""+{TAB}""" & vbNewLine & _ "WshShell.SendKeys ""~""" CreateObject("Scripting.FileSystemObject").createtextfile(sTitle).write s sPath = "wscript " & ThisWorkbook.Path & "\runme.vbs" Shell sPath, vbNormalFocus End Sub 

@Pierre – 你的想法是写这样的^^？

然后在调用表单之前调用它，然后在某个地方删除它？ 起初我以为你不会在任何地方创build文件，但现在我已经尝试了，我注意到了。 它应该工作。

Answer 2

它看起来好像你的插件在保存事件之前沉没了应用程序工作簿，所以快速修复以允许保存，将是再次沉没，所以在你的代码中，有以下

在一个正常的模块中有以下几个

 Public cResink As clsResinkApplication 

有一个名为clsResinkApplication的类，该类的代码如下

 Private WithEvents resinkApp As Excel.Application Public Sub init2(appToResink As Excel.Application) Set resinkApp = appToResink End Sub Private Sub resinkApp_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean) ActiveWorkbook.SaveAs "test.xlsx" End Sub 

然后在打开的工作簿中可以有以下内容

 Private Sub Workbook_Open() Set cResink = New clsResinkApplication cResink.init2 Application End Sub 

这应该转移到你的保存水槽之前的插件。

Answer 3

你启动插件popup窗口的事实“冻结”了代码。 我无法在VBA中asynchronous地做到这一点（现在我开始使用VB.NET，我觉得这些东西好多了！）。 最好的我可以想到的是： – 保存在一个temparary文件（temp.vbs为前）一些代码，运行它之前启动窗体：

 Dim s$ s = "Set WshShell = WScript.CreateObject(""WScript.Shell"")" & vbNewLine & _ "WScript.Sleep 6000" & vbNewLine & _ "WshShell.SendKeys ""+{TAB}""" & vbNewLine & _ "WshShell.SendKeys ""~""" CreateObject("Scripting.FileSystemObject").createtextfile(FileName).write s shell(filename) 

Answer 4

我想感谢@Vityata，@Pierre用VBScript来做这个想法，同时也把VBScipt的内容写在VBA代码里面。

我最终做的是：

1.在调用我的保存之前添加了Call WShellSendKeys 。

 '========== Call the VBScript to run a Shell to send to Keys in the background ====== Call WShellSendKeys NewWB.SaveAs "Budget usage - " & Year(Date) & "-" & Month(Date - 30) & " " & PMList(r) 

2.检查VBSciprt是否已经存在，如果没有创build它。

 Public Sub WShellSendKeys() Dim wsh As Object Dim objFile As Object Dim objFSO As Object Set wsh = VBA.CreateObject("WScript.Shell") If Dir(VBScrPath) <> "" Then ' <-- VBS file name already exits in folder >> there's no need to re-create it, just run it ' Run Shell wsh.Run "wscript " & Chr(34) & VBScrPath & Chr(34), vbNormalFocus Else ' VBS file name doesn't exits in folder >> create it Call WriteToVBS wsh.Run "wscript " & Chr(34) & VBScrPath & Chr(34), vbNormalFocus End If End Sub 

3.另一个用SendKeys创buildVBScript的Sub。

 Sub WriteToVBS() Dim objFile As Object Dim objFSO As Object Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile(VBScrPath, 8, True) ' --- Text to write into the VBScript file --- objFile.WriteLine ("Option Explicit") objFile.WriteLine ("") objFile.WriteLine ("Dim WshShell") objFile.WriteLine ("Dim i") objFile.WriteLine ("") objFile.WriteLine ("Set WshShell = CreateObject(""WScript.Shell"")") objFile.WriteLine ("WScript.Sleep(4000)") objFile.WriteLine ("") objFile.WriteLine ("WshShell.SendKeys ""{R}"",True") objFile.WriteLine ("WScript.Sleep(1000)") objFile.WriteLine ("For i = 1 To 2") objFile.WriteLine ("WshShell.SendKeys ""{ENTER}"",True") objFile.WriteLine ("WScript.Sleep(1000)") objFile.WriteLine ("Next") objFile.Close Set objFile = Nothing Set objFSO = Nothing End Sub