AW: @Nepumuk @Rudi
08.04.2015 11:22:36
Nepumuk
Hallo,
nachlesen kannst du so etwas nicht, aber ich hab so Sachen erlebt wo die CopyPicture-Methode immer in einen Fehler lief bis ich sie mit Call aufgerufen habe, dann ging es plötzlich. Das war mir eine Lehre und seitdem sehen meine Programme ein bisschen anders aus. Beispiel:
' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************
Option Explicit
Private Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLongA Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongA Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
Private Declare Function SetActiveWindow Lib "user32.dll" ( _
ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function FormatMessageA Lib "kernel32.dll" ( _
ByVal dwFlags As Long, _
ByRef lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
ByRef Arguments As LongPtr) As Long
Private Declare PtrSafe Function GetLastError Lib "kernel32.dll" () As Long
Private Const GWL_EXSTYLE As Long = -20&
Private Const WS_EX_APPWINDOW As LongPtr = &H40000
Private Const LANG_NEUTRAL As Long = &H0
Private Const ERROR_BUFFER As Long = &HC8
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const GC_CLASSNAMEUSERFORM As String = "ThunderDFrame"
Private Sub CommandButton1_Click()
Call Unload(Me)
End Sub
Private Sub UserForm_Activate()
Dim lngptrFormHwnd As LongPtr, lngptrStyle As LongPtr
Dim lngptrReturn As LongPtr
Dim strBuffer As String
On Error GoTo err_exit
With Application
Let .IgnoreRemoteRequests = True
Let .Visible = False
End With
Let lngptrFormHwnd = FindWindowA(GC_CLASSNAMEUSERFORM, Caption)
If lngptrFormHwnd = 0 Then Call Err.Raise(Number:=vbObjectError, _
Description:="Userformfenster nicht gefunden.")
Let lngptrStyle = GetWindowLongA(lngptrFormHwnd, GWL_EXSTYLE)
If lngptrStyle = 0 Then
Let strBuffer = Space$(ERROR_BUFFER)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, _
LANG_NEUTRAL, strBuffer, ERROR_BUFFER, ByVal CLngPtr(0))
Call Err.Raise(Number:=vbObjectError, Description:=strBuffer)
Else
Let lngptrStyle = lngptrStyle Or WS_EX_APPWINDOW
Let lngptrReturn = SetWindowLongA(lngptrFormHwnd, GWL_EXSTYLE, lngptrStyle)
If lngptrReturn = 0 Then
Let strBuffer = Space$(ERROR_BUFFER)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, _
LANG_NEUTRAL, strBuffer, ERROR_BUFFER, ByVal CLngPtr(0))
Call Err.Raise(Number:=vbObjectError, Description:=strBuffer)
Else
Let lngptrReturn = SetActiveWindow(CLngPtr(Application.hwnd))
If lngptrReturn = 0 Then
Let strBuffer = Space$(ERROR_BUFFER)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, _
LANG_NEUTRAL, strBuffer, ERROR_BUFFER, ByVal CLngPtr(0))
Call Err.Raise(Number:=vbObjectError, Description:=strBuffer)
Else
Let lngptrReturn = SetActiveWindow(lngptrFormHwnd)
If lngptrReturn = 0 Then
Let strBuffer = Space$(ERROR_BUFFER)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, _
LANG_NEUTRAL, strBuffer, ERROR_BUFFER, ByVal CLngPtr(0))
Call Err.Raise(Number:=vbObjectError, Description:=strBuffer)
End If
End If
End If
End If
Exit Sub
err_exit:
Call MsgBox("Fehler: " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehlermeldung")
End Sub
Private Sub UserForm_Terminate()
With Application
Let .IgnoreRemoteRequests = False
Let .Visible = True
End With
End Sub
Mag übertrieben sein, aber Vorsicht ist die Mutter der Porzellankiste.
Gruß
Nepumuk