VBA Print screen on dual screen help. I need just the left screen shot. Thanks!

jackjo05

New Member
Joined
Dec 19, 2013
Messages
8
Hi Guys,

I was wondering if someone can help finish / make a vba code to take a print screen of just the left screen on a dual monitor?

Right now I have it so it takes a print screen of the active screen but this does not work when I try and use a keyboard shortcut while in excel.

Below is the code I have so far. It takes a print screen and paste into the tab called "ss"

Thanks for any help!!!

Sub PrintTheScreen()
Application.SendKeys "(%{1068})"
DoEvents

Sheets("SS").Select
ActiveSheet.Pictures.Paste.Select


End Sub
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Well; yes and no.

First, there is no “left” monitor. If there are two there is a primary and a secondary monitor. You can, of course, physically move the monitors around and change their “left/right” position, but this will not change the primary/secondary designation.

I think what you want is to either capture both screens or one of the windows regardless of which screen it is on. Here is some code for you to test.

Install instructions:


  1. Start with an empty excel workbook with a sheet named “ss”
  2. Create a module alt F11 Insert Module and paste the code below into it
  3. Save the workbook

To run:

For window capture:

  1. Start up the application “Hearts”
  2. Run macro testHearts
  3. Verify that the hearts screen was captured into the worksheet “ss”

For all screens capture:
1. Run macro testAll

Note: If you really want to capture the entire primary screen, we can do that by cropping the testAll captured image


Code:
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     ' key up
Private Const VK_SNAPSHOT = &H2C        ' print screen key
Private Const VK_MENU = &H12            ' alt key
Private Const VK_CONTROL = &H11         ' ctrl key
Sub ScreensCapture(vk)
    keybd_event vk, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 1
    keybd_event vk, 0, KEYEVENTF_KEYUP, 0
End Sub
Sub Window_Capture_VBA(Optional sTitle = "")
    Application.CutCopyMode = False
    If sTitle <> "" Then
        AppActivate sTitle
        Application.Wait Now() + TimeValue("00:00:03")
        ScreensCapture VK_MENU
    Else
        ScreensCapture VK_CONTROL
    End If
    Application.Wait Now() + TimeValue("00:00:03")
    Sheets("ss").Paste
    Application.CutCopyMode = False
End Sub
Sub testHearts()
    Window_Capture_VBA "Hearts" ' captures window titled "Hearts"
End Sub
Sub testAll()
    Window_Capture_VBA          ' captures all screens
End Sub
 
Upvote 0
Thanks for the help! I messed around with the codes a bit and it works well for capturing the whole screen! Thanks. I am like you said looking for the "primary" screen techinically, do you know how I could go about cropping the image with code? I will try and google but thanks for any help! I also have another question you might know about.

I need to copy and paste information using a macro from a document downloaded on the interenet but the title of the workbook changes everytime you open it.

Do you know if it would be possible to use the code below to write an if statement of some sort on the title?
The first words in the title are always the same and all that needs to be in the if statement if possible.
The document would be opened like so "Consigment Balance XXXXX"
So if there was a way to make an if statament saying copy and paste active window if title contains "Consignment Balance"...if title contains "Inventory Scan"...do the same and if any thing else do nothing.

If thats is to confusing I can explain or send you the worksheet so you would have an idea.

Thanks!!

Sub CNPIS()
'
' CNPIS Macro
'
' Keyboard Shortcut: Ctrl+Shift+I
'
Windows("Inventory_scan[1]").Activate
Cells.Select
Cells.EntireColumn.AutoFit
Selection.Copy
Windows("PV Consignment Audit Template Macro.xltm").Activate
ActiveWindow.SmallScroll Down:=-15
Range("A1").Select
ActiveSheet.Paste
Range("J8").Select
End Sub
 
Upvote 0
From help...

In determining which application to activate, title is compared to the title string of each running application. If there is no exact match, any application whose title string begins with title is activated. If there is more than one instance of the application named by title, one instance is arbitrarily activated.
 
Upvote 0
Here's a "cropped" image capture

You need to set the 960 to your left monitor's width...

(If you look, you will probably be able to determine this width in VBA, but I'm outta' time.




Code:
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
 bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal Index As Long) As Long
Declare Function GetSystemMetrics16 Lib "user" Alias "GetSystemMetrics" _
(ByVal nIndex As Integer) As Integer

Private Const KEYEVENTF_KEYUP = &H2     ' key up
Private Const VK_SNAPSHOT = &H2C        ' print screen key
Private Const VK_MENU = &H12            ' alt key
Private Const VK_CONTROL = &H11         ' ctrl key
Sub ScreensCapture(vk)
    keybd_event vk, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, 0, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 1
    keybd_event vk, 0, KEYEVENTF_KEYUP, 0
End Sub
Sub Window_Capture_VBA(Optional sTitle = "")
    Application.CutCopyMode = False
    If sTitle <> "" Then
        AppActivate sTitle
        Application.Wait Now() + TimeValue("00:00:03")
        ScreensCapture VK_MENU
    Else
        ScreensCapture VK_CONTROL
    End If
    
    Application.Wait Now() + TimeValue("00:00:03")
    Sheets("ss").Paste
    
    Selection.ShapeRange.PictureFormat.CropRight = [B][COLOR=#008000]960  [/COLOR][/B]' <-- set this to the width of the (left) primary monitor
    Selection.Left = 0                                  ' I got tired of looking for the image
    Selection.Top = 0
    
    Application.CutCopyMode = False
End Sub
Sub testHearts()
    Window_Capture_VBA "Hearts" ' captures window titled "Hearts"
End Sub
Sub testAll()
    Window_Capture_VBA          ' captures all screens
End Sub
 
Upvote 0
Thanks! That works perfectly for what I am doing!

Question about the other thing. Can you use appactivate to open a window in excel? I've been on google and lots of the stuff I've been reading pertains to opening up other applications and such but none about active windows in excel.

Thanks again.
 
Upvote 0
opening up other applications

if you want to "start" another application:

Code:
Sub StartProgram(sProg)
    Dim wsh As Object: Set wsh = VBA.CreateObject("WScript.Shell")
    wsh.Run Chr(34) & sProg & Chr(34), 5, False
End Sub
Sub test03()
    StartProgram "C:\Program Files (x86)\Mozilla Firefox\firefox.exe"
End Sub
 
Upvote 0
Hi thanks for the help again. I guess I need to be more clear in explaning, sorry.

My goal:
-Use a macro that copys and paste a sheet from an open excel spreadsheet downloaded from the internet to another spreadsheet in excel.

Problem:
-The spreadsheet I need to copy and paste from is downloaded manually from the internet but the name changes.

Solution proposed:
-Have the macro recongize the first two words "consignment balance....." in the title of the temp file, copy and paste from there into my other workbook spreadsheet

I have used this code below to do it on a file that does not change the name/title but it does not work in this situation as the name/title of the work book always changes besides the first two words.


Sub CNPIS()
'
' CNPIS Macro
'
' Keyboard Shortcut: Ctrl+Shift+I
'
Windows("Inventory_scan[1]").Activate
Cells.Select
Cells.EntireColumn.AutoFit
Selection.Copy
Windows("PV Consignment Audit Template Macro.xltm").Activate
ActiveWindow.SmallScroll Down:=-15
Range("A1").Select
ActiveSheet.Paste
Range("J8").Select
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,275
Messages
6,171,126
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top