Ekran görüntüsü almak (PrtScn)

Katılım
26 Kasım 2015
Mesajlar
5
Excel Vers. ve Dili
Excel 2013 TR
Değerli Arkadaşlarım,

Ekran görüntüsünü aşağıdaki kod ile alıyorum. Bu kod bana o an aktif olan ekranın görüntüsünü veriyor. Fakat çift ekran kullanıyorum ve görüntüsünü alacağım ekranı kod ile seçmek istiyorum. Mesela 1. ekranda VBA penceresi açık 2. ekranda da excel sayfası açık ama kodun her zaman 2. ekrandan görüntü almasını istiyorum Bunu nasıl yapabilirim?

Saygılarımla.


Kod:
Private Declare PtrSafe Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer


Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12

Dim blnAboveVer4 As Boolean

Sub takeScreenShot()

   If blnAboveVer4 Then
     keybd_event VK_SNAPSHOT, 0, 0, 0
   Else
     keybd_event VK_SNAPSHOT, 1, 0, 0
   End If
   
   ActiveSheet.Range("A1").Activate
   
    ActiveSheet.Pictures.Paste.Select
   
   
End Sub
 

turist

Destek Ekibi
Destek Ekibi
Katılım
18 Kasım 2009
Mesajlar
5,102
Excel Vers. ve Dili
2013 64Bit
English
Kod:
Private Declare PtrSafe Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer

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

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12

Dim blnAboveVer4 As Boolean

Sub takeScreenShot()
   If blnAboveVer4 Then
     keybd_event VK_SNAPSHOT, 0, 0, 0
   Else
     keybd_event VK_SNAPSHOT, 1, 1, 1
   End If
   
   ActiveSheet.Range("A1").Activate
   
    ActiveSheet.Pictures.Paste.Select
   
   
End Sub
şeklinde deneyin.
 
Üst