Hardcopy VBA

Hallo

'
'   15/10/2003
'©  Ing.Friedrich Grath
'@  grath.fritz@ aon.at
'

'Alles in ein Modul
Option Explicit

Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long

Public Const VK_MENU = &H12
Public Const KEYEVENTF_KEYUP = &H2

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

'Aufruf zum erstellen des Screenshot
Sub Screenshot()
'gesamten Bildschirm:
GetWindowSnapShot 0
'oder nur das aktives Fenster:
'GetWindowSnapShot 1
Sheets("Tabelle1").Paste
ThisWorkbook.Save
End Sub

Public Sub GetWindowSnapShot(Mode As Long)
Dim altscan%, NT As Boolean
NT = IsNT

If Not NT Then
If Mode = 0& Then Mode = 1& Else Mode = 0&
End If

If NT And Mode = 0 Then
    keybd_event vbKeySnapshot, 0&, 0&, 0&
Else
    altscan = MapVirtualKey(VK_MENU, 0)
    keybd_event VK_MENU, altscan, 0, 0
    DoEvents
    keybd_event vbKeySnapshot, Mode, 0&, 0&
End If

DoEvents
keybd_event VK_MENU, altscan, KEYEVENTF_KEYUP, 0
End Sub

Public Function IsNT() As Boolean
Dim verinfo As OSVERSIONINFO
    verinfo.dwOSVersionInfoSize = Len(verinfo)
    If (GetVersionEx(verinfo)) = 0 Then Exit Function
    If verinfo.dwPlatformId = 2 Then IsNT = True
End Function

Code eingefügt mit Syntaxhighlighter 2.4

mfg, GraFri

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Reinhard

da habe ich was verbrochen :-)
es ist nicht so einfach wie ich es mir zu Anfang gedacht habe

bastle gerade am Code

hier ist mein ansatz

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

Sub hmmmmm()
Const KEYEVENTF_KEYUP = &H2
  Const VK_MENU = &H12
  Const VK_SNAPSHOT = &H2C
On Error Resume Next
For i = 1 To 1
'SendKeys "%{f4}"
keybd_event VK_MENU, 0, 0, 0 ''ALT-Taste
keybd_event VK_SNAPSHOT, 0, 0, 0 ''Druck-Taste
Application.Dialogs(i).Show
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
'SendKeys "%"
'SendKeys "{esc}" 'code bleibt hängen aber mit gedrückter alt-taste geht es wieder
Next
End Sub

Code eingefügt mit Syntaxhighlighter 1.16

funzt aber noch nicht

es wird nur der desktophindergrund angezeigt und der code bleibt hängen

die schleife ist momentan natürlich sinnlos da ich das Problem mit dem Screenshot noch nicht gelöst habe

Wo liegt mein Fehler

p.s habe den Code aus VB übernommen (Google) :-)

Gruß
Christian

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread