AW: API-Funktionen
18.08.2021 13:47:02
volti
Hallo Peter,
irgendwie bekomme ich keine Antwortermails mehr, daher sehe ich erst jetzt Deine Beiträge....
Zunächst einmal zu den Declares, wo alles rot ist. Das ist völlig normal und in Ordnung.
Wenn Du einen 64 Bit Rechner hast, werden die Deklarationen für die alten Versionen in rot dargestellt, weil sie nicht laufbar sind.
Durch den Compilerschalter werden sie aber auch nicht berücksichtigt und führen zu keinem Fehler.
Dann schlage ich Dir vor, alles API-Deklarationen in einem Extramodul (API) zu definieren, dann brauchst Du das nicht zig-mal vorhalten.
Und wenn Du Deine API-Aktionen in einer Sub zusammenziehst (UF unverschiebbar machen), brauchst Du auch den ganzen Code nur einmal und kannst ihn aus jeder Userform aufrufen..
#If VBA7 or Win65: Hast Du Dich da verschrieben? Win65 gibt es nicht....
Hier die angepasste Datei, die ich aufgrund des umfangreichen Codes nicht umfänglich testen kann/will. Bezgl. der API-Funktionen ist alles in Ordnung für 32 und 64-Bit-Versionen. Es kommen keine Fehler und es flackert auch nichts.
Angepasste Datei
Und zu Deiner Frage, (die ich nicht ganz verstanden habe): M.E. ist ein Unterbinden der UF-Verschiebung ohne API-Unterstützung nicht möglich.
Code:
[Cc][+][-]
' Aufrufbeispiel aus einer UF (dort gehört der Code auch rein)
Private Sub UserForm_Activate()
Call UF_Unverschiebbar(Me.Caption)
End Sub
'API-Deklarationen (im Modul API)
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function DeleteMenu Lib "user32" ( _
ByVal hMenu As LongPtr, _
ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Private Declare PtrSafe Function GetSystemMenu Lib "user32" ( _
ByVal hWnd As LongPtr, _
ByVal bRevert As Long) As LongPtr
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function DeleteMenu Lib "user32" ( _
ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" ( _
ByVal hwnd As Long, _
ByVal bRevert As Long) As Long
#End If
Private Const MF_BYCOMMAND = &H0
Private Const SC_MOVE = &HF010
Sub UF_Unverschiebbar(sCaption As String)
#If VBA7 Then
Dim hMenu As LongPtr
#Else
Dim hMenu As Long
#End If
'Anfang - Userform unverschiebbar machen
hMenu = GetSystemMenu(FindWindow(vbNullString, sCaption), 0)
If hMenu <> 0 Then
DeleteMenu hMenu, SC_MOVE, MF_BYCOMMAND
End If
'Ende - Userform unverschiebbar machen
End Sub
_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz