代码之家 › 专栏 › 技术社区 › Shai Rado

尝试发送到Excel加载项时,Excel VBA SendKey不工作

sendkeys add-in excel vba

3

Shai Rado · 技术社区 · 8 年前

简介。 :在我的公司,我们在Excel中安装了一个安全插件,防止我们在不输入所需参数的情况下保存新的Excel工作簿。

挑战 :使用 SendKeys 发送此Excel加载项所需的键。

问题 :当加载项屏幕弹出时(如下面的屏幕截图所示),代码似乎不会继续到这一行: SendKeys " ", True .

我的密码 (相关部分)

编辑1 :下面的代码位于 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

4 回复 | 直到 8 年前

1

2

Vityata 8 年前

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

@皮埃尔-你的想法是写这样的东西^^?

然后在调用表单之前调用它,然后在稍后的某个地方删除它?最初我以为你不会在任何地方创建文件,但现在我试过了,我注意到了。它应该起作用。

2

Nathan_Sav 8 年前

看起来您的外接程序在保存事件之前正在下沉应用程序工作簿,因此允许保存的快速修复方法是再次下沉它,因此在代码中,具有以下内容

在正常模块中,具有以下功能:

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

这应该在外接程序之前转移到你的储蓄池。

3

2

Pierre 8 年前

您启动插件弹出窗口的事实“冻结”了代码。我不知道在VBA中异步实现这一点的方法(现在我开始使用VB.NET,我对这些东西感觉好多了!)。我能想到的最好办法是: -将一些代码保存在临时文件(例如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)

4

1

Shai Rado 8 年前

我要感谢@Vityata,@Pierre提出了用VBScript实现的想法,并在VBA代码中编写了VBScipt的内容。

我最后做的是:

1. 补充道 Call WShellSendKeys 在调用我的Save之前。

'========== 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是否已存在,如果不存在,则创建它。

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 .

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