截取活动窗口的屏幕截图
Set Wshshell=CreateObject("Word.Basic")
WshShell.sendkeys"%{prtsc}"
WScript.Sleep 1500
运行Mspaint并粘贴
set Wshshell = WScript.CreateObject("WScript.Shell")
Wshshell.Run "mspaint"
WScript.Sleep 500
WshShell.AppActivate "Paint"
WScript.Sleep 500
WshShell.sendkeys "^(v)"
WScript.Sleep 1500
在这里,对活动窗口进行截图的操作工作正常..此外,它以mspaint开始,但内容没有粘贴到paint文件中。
.Sendkeys的^V参数是错误的,它应该是:
WshShell.sendkeys "^v"
.AppActivate之后的.Sleep似乎很关键;我不能让它"工作",直到我增加睡眠时间:
WshShell.AppActivate "Paint"
WScript.Sleep 5000
你的问题证明。sendkeys是不可靠的。看看这里,尤其是Moby Disk的发帖,想想其他的策略。
如果您想实现类似"PrintScreen's Save-as-JPG"的功能,下面是我的代码:
' ----------------------------------------------------------------------
' Clipboard to JPG ...using Word.Basic and Excel
' ----------------------------------------------------------------------
Dim DosBasic : Set DosBasic = CreateObject("Word.Basic")
Dim XLS : Set XLS = CreateObject("Excel.Application")
Dim T0 : T0 = Now
Call GetScreenshot
Call Ding
Call MakeFolderIfNotExist(ScreenshotFolder & "" & CurrDate)
Call StoreClipboard(CurrDate & "" & CurrTime & ".jpg")
XLS.Application.Quit
' ----------------------------------------------------------------------
Sub MakeFolderIfNotExist(ByVal FolderName)
' ----------------------------------------------------------------------
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
if not FSO.FolderExists(FolderName) then FSO.CreateFolder(FolderName)
End Sub
' Uses less known Word.Basic to correctly send (Alt+)PrintScreen.
' Unfortunately, the Word.Basic takes SEVERAL seconds to load
' ----------------------------------------------------------------------
Sub GetScreenshot
' ----------------------------------------------------------------------
'Dim DosBasic : Set DosBasic = CreateObject("Word.Basic")
'DosBasic.SendKeys "{1068}" ' = Printscreen = entire screen
DosBasic.SendKeys "%{prtsc}" ' = Alt+PrintScreen = only active window
End Sub
' Uses Excel and its mighty Chart object, to create Exportable JPG image
' ----------------------------------------------------------------------
Sub StoreClipboard(ByVal Filename)
' ----------------------------------------------------------------------
Const xlLandscape = 2 ' Landscape page
Const xlPortrait = 1 ' Portrait page
'Dim XLS : Set XLS = CreateObject("Excel.Application")
Dim Sheet : Set Sheet = XLS.Workbooks.Add
Dim Chart : Set Chart = XLS.Charts.Add
Const ScreenshotFolder = "C:TempScreenshots"
Call MakeFolderIfNotExist(ScreenshotFolder)
XLS.Visible = False
XLS.ActiveSheet.PageSetup.Orientation = xlLandscape
XLS.ActiveWindow.Zoom = 100
Chart.Paste
Chart.Export ScreenshotFolder & "" & Filename
XLS.ActiveWorkbook.Saved = True
XLS.ActiveWorkbook.Close False
'XLS.Application.Quit
End Sub
' ----------------------------------------------------------------------
Function CurrDate
' ----------------------------------------------------------------------
'Dim T0 : T0 = Now
CurrDate = Year(T0) & "-" & Right("0"&Month(T0),2) & "-" & Right("0"&Day(T0),2)
End Function
' ----------------------------------------------------------------------
Function CurrTime
' ----------------------------------------------------------------------
'Dim T0 : T0 = Now
CurrTime = Right("0"&Hour(T0),2) & "." & Right("0"&Minute(T0),2) & "." & Right("0"&Second(T0),2)
End Function
' Play selected sound to indicate 'finish successfully'
' ----------------------------------------------------------------------
Sub Ding
' ----------------------------------------------------------------------
Const wavFile = "C:WindowsmediaWindows Background.wav"
Dim oVoice : Set oVoice = CreateObject("SAPI.SpVoice")
Dim oSpFileStream : Set oSpFileStream = CreateObject("SAPI.SpFileStream")
oSpFileStream.Open wavFile
oVoice.SpeakStream oSpFileStream
oSpFileStream.Close
End Sub
行之有效。只是有点慢——创造"词"。"基本"会导致5秒的延迟。不知道为什么。之后,Excel就可以正常工作了。
例如,你可以让它在热键上运行,如Ctrl+F12或类似的东西(通过创建快捷键),然后,将在任何地方工作