Excel VBA Subroutine, Fix my Code: print screen clipboard paste to microsoft paint

  • Status Closed
  • Budget $10 - $30 USD
  • Total Bids 9

Project Description

**I need this following code to work correctly. It currently fails.

It should be able to:

1. capture a screen shot,

2. open microsoft paint,

3. paste image of screen shot to microsoft paint,

4. save file as GIF FORMAT

Use VBA found in Excel

** Option Explicit

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _

bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_KEYUP = &H2

Private Const VK_SNAPSHOT = &H2C

Private Const VK_MENU = &H12

Private Const VK_TAB = &H9

Private Const VK_V = &H56

Private Const VK_LCONTROL = &HA2

Sub AltPrintScreen()

Dim myappid

'go back to software AIMS screen (see attached file [url removed, login to view])

keybd_event VK_MENU, 0, 0, 0

keybd_event VK_TAB, 0, 0, 0

keybd_event VK_TAB, 0, KEYEVENTF_KEYUP, 0

keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0

'take snap shoot of the screen and put into clipboard

keybd_event VK_MENU, 0, 0, 0

keybd_event VK_SNAPSHOT, 0, 0, 0

keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0

keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0

'OPEN MS PAINT

myappid = Shell("[url removed, login to view]", 1)

AppActivate myappid

SendKeys "%FS{ENTER}"

DoEvents

'paste image into MSPaint

keybd_event VK_LCONTROL, 0, 0, 0

keybd_event VK_V, 0, 0, 0

keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0

keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0

'SAVE MSPAINT FILE AS GIF

SendKeys "%FS{ENTER}"

End Sub

Get free quotes for a project like this

Looking to make some money?

  • Set your budget and the timeframe
  • Outline your proposal
  • Get paid for your work

Hire Freelancers who also bid on this project

    • Forbes
    • The New York Times
    • Time
    • Wall Street Journal
    • Times Online