Vbscript打印屏幕到MSpaint



截取活动窗口的屏幕截图

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或类似的东西(通过创建快捷键),然后,将在任何地方工作

相关内容

  • 没有找到相关文章

最新更新