Abfrage 32 oder 64 Bit
18.04.2022 16:38:05
Tony
ich stehe grad vor einem Problem. Vor einiger Zeit bin ich hier fündig geworden bei dem Thema Inaktivitätschliessung. Dabei habe ich einen guten Code gefunden und diesen für mich abgeändert. Das funktioniert auch alles bei mir super, aber sobald ich dies auf dem Firmen PC's teste fällt sofort ein Problem auf. Ich selbst habe offensichtlich die 32Bit Office Version und in der Firma haben wir die 64Bit Version. Nun sollte ich eine Abfrage einfliessen lassen die des klärt und das ganze so abändern das es am Ende bei beiden Version reibungslos funktioniert.
Vielleicht hat jemand ja ne einfache Idee wie ich das lösen kann.
Option Explicit
Dim NotClose As Boolean
Dim t1 As Single, t2 As Single
Dim nForeColor As Long
Dim nBackColor As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" ( _
ByVal hwnd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const GWL_STYLE = -&H10
Private Const WS_SYSMENU = &H80000
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const Warten = 15
'von GraFri auf www.herber.de
Sub FensterPosition(ByVal strTitel As String, Modus As Boolean)
Dim lngRet As Long
Dim hwnd As Long
hwnd = FindWindow(vbNullString, strTitel)
If hwnd = 0 Then
MsgBox "Fenster wurde nicht gefunden!"
Exit Sub
End If
If Modus = True Then
lngRet = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, _
FLAGS)
Else
lngRet = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, _
FLAGS)
End If
End Sub
Private Sub UserForm_Initialize()
If ThisWorkbook.Saved Then
CommandButton2.Caption = "Jetzt schließen" '& vbLf & "(Datei ist gespeichert)"
Else
CommandButton2.Caption = "Jetzt schließen"
End If
'Standartfabe des Buttons wird genutzt
nForeColor = NichtSchliessen.ForeColor
nBackColor = NichtSchliessen.BackColor
'Standartfabe des Buttons wird genutzt
nForeColor = CommandButton2.ForeColor
nBackColor = CommandButton2.BackColor
End Sub
Private Sub CommandButton2_Click()
NotClose = False
t2 = Timer
End Sub
Private Sub UserForm_Activate()
Dim lHwnd As Long
lHwnd = FindWindow("ThunderDFrame", Me.Caption)
FensterPosition Me.Caption, True
SetWindowLong lHwnd, HWND_TOPMOST, GetWindowLong(lHwnd, GWL_STYLE) And Not WS_SYSMENU
DrawMenuBar lHwnd
End Sub
Function Abbruch() As Boolean
t1 = Timer
t2 = Timer + Warten
On Error Resume Next
Me.Show vbModeless
If ERR.Number = 0 Then
Do
Label1.Caption = "Die Ersatzteile werden in " & Warten - Int(Timer - t1) & " Sekunden" & vbLf & "geschlossen..."
DoEvents
Loop Until Timer > t2
End If
Abbruch = NotClose
Unload Me
End Function
Private Sub NichtSchliessen_Click()
NotClose = True
t2 = Timer
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub
Private Sub NichtSchliessen_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Farbe des Buttons wird gewechselt
NichtSchliessen.ForeColor = RGB(255, 255, 255)
NichtSchliessen.BackColor = RGB(255, 128, 0)
End Sub
Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Farbe des Buttons wird gewechselt
NichtSchliessen.ForeColor = nForeColor
NichtSchliessen.BackColor = nBackColor
End Sub
Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Farbe des Buttons wird gewechselt
CommandButton2.ForeColor = RGB(255, 255, 255)
CommandButton2.BackColor = RGB(255, 128, 0)
End Sub
Private Sub Label3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Farbe des Buttons wird gewechselt
CommandButton2.ForeColor = nForeColor
CommandButton2.BackColor = nBackColor
End Sub
