Ich habe hier einen Code der soweit auf meinem Rechner mit 64bit läuft. Ich hab hier vor Funktion immer PtrSafe geschrieben.
Allerdings scheint das ganze nicht unter Excel 2007 32bit zu laufen.
Wie muss das ganze angepasst werden, damit es unter 64/32 bit und Excel 2007 läuft?
Da ich mich nicht wirklich damit auskenne, wäre es schön wenn mir jemand behilflich sein würde...
Code:
Option Explicit ' Variablendefinition erforderlich
Option Private Module ' damit Makros nich von Hand gestartet werden können
Public Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe 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
Declare PtrSafe Function SetActiveWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Public Enum Parameter
HWND_TOPMOST = -1
SWP_NOSIZE = &H1
SWP_NOMOVE = &H2
SWP_NOACTIVATE = &H10
SWP_SHOWWINDOW = &H40
End Enum
Public DaEt As Date ' Prüfzeit für Eingabe in der Tabelle
Public DaET1 As Date ' Prüfzeit für Reaktion in Userform
Public DaET2 As Date ' Zeit zum Wechsel der Anzeige
Public BoZu As Boolean ' Variable Zustand
Public Const DaZeit As Date = "00:10:00" ' Zeitabstand prüfen, Eingabe Tabelle
Public Const DaZeit1 As Date = "00:01:00" ' Zeitabstand prüfen, Userform
Public Const DaZeit2 As Date = "00:00:01" ' Zeitabstand für Restzeit
Public BoEnde As Boolean ' Variable Beenden
Sub Zeitmakro() ' Zeitmakro Eingabe Tabelle
BoZu = False
On Error Resume Next ' Fehlerbehandlung ausschalten
' Makro anhalten
Application.OnTime EarliestTime:=DaET1, Procedure:="Zeitmakro", Schedule:=False
On Error GoTo 0 ' Fehlerbehandlung einschalten
DaEt = Now + DaZeit ' neue Startzeit setzen
Application.OnTime DaEt, "Start" ' Makro zum festgelegten Zeitpunkt starten
End Sub
Sub Start() ' Zeitmakro Anzeige Userform
DaET1 = Now + DaZeit1 ' Zeit für das schließen der Datei festlegen
Application.OnTime DaET1, "Schließen" ' Makro zum festgelegten Zeitpunkt starten
SetActiveWindow FindWindow("xlMain", vbNullString)
frm_Abfrage.Show ' UserForm starten
End Sub
Sub Schließen()
'Unload UserForm1
If BoZu = False Then
ThisWorkbook.Save ' Datei speichern
' falls nur eine Datei auf Excel schließen
' ess erfolgt eine Abfrage zum speichern
If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End If
End Sub
Sub Zeitabstand() ' Makro für laufende Zeit in UserForm
With frm_Abfrage
' neue Zeit auf das Label schreiben
.LbL_Zeit.Caption = "Restzeit: " & CDate(CDate(Application.Substitute(.LbL_Zeit.Caption, "Restzeit: ", "")) - DaZeit2)
' Prüfen ob Zeit abgelaufen ist
If CDate(Right(.LbL_Zeit.Caption, 8)) > 0 Then
DaET2 = Now + DaZeit2 ' neue Startzeit setzen
Application.OnTime DaET2, "Zeitabstand" ' Makro zum festgelegten Zeitpunkt starten
End If
End With
End Sub
#if Win64 then
Declare PtrSafe Function MyMathFunc Lib "User32" (ByVal N As LongLong) As LongLong
#else
Declare Function MyMathFunc Lib "User32" (ByVal N As Long) As Long
#end if
#if VBA7 then
Declare PtrSafe Sub MessageBeep Lib "User32" (ByVal N AS Long)
#else
Declare Sub MessageBeep Lib "User32" (ByVal N AS Long)
#end if
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Ich hab das jetzt mal mit eingebaut, sieht dann so aus:
Code:
Option Explicit ' Variablendefinition erforderlich
Option Private Module ' damit Makros nich von Hand gestartet werden können
#If VBA7 And Win64 Then ' 64 bit Excel
Public Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe 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
Declare PtrSafe Function SetActiveWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
#Else ' 32 bit Excel
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
Declare Function SetActiveWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
#End If
Public Enum Parameter
HWND_TOPMOST = -1
SWP_NOSIZE = &H1
SWP_NOMOVE = &H2
SWP_NOACTIVATE = &H10
SWP_SHOWWINDOW = &H40
End Enum
Public DaEt As Date ' Prüfzeit für Eingabe in der Tabelle
Public DaET1 As Date ' Prüfzeit für Reaktion in Userform
Public DaET2 As Date ' Zeit zum Wechsel der Anzeige
Public BoZu As Boolean ' Variable Zustand
Public Const DaZeit As Date = "00:10:00" ' Zeitabstand prüfen, Eingabe Tabelle
Public Const DaZeit1 As Date = "00:01:00" ' Zeitabstand prüfen, Userform
Public Const DaZeit2 As Date = "00:00:01" ' Zeitabstand für Restzeit
Public BoEnde As Boolean ' Variable Beenden
Sub Zeitmakro() ' Zeitmakro Eingabe Tabelle
BoZu = False
On Error Resume Next ' Fehlerbehandlung ausschalten
' Makro anhalten
Application.OnTime EarliestTime:=DaET1, Procedure:="Zeitmakro", Schedule:=False
On Error GoTo 0 ' Fehlerbehandlung einschalten
DaEt = Now + DaZeit ' neue Startzeit setzen
Application.OnTime DaEt, "Start" ' Makro zum festgelegten Zeitpunkt starten
End Sub
Sub Start() ' Zeitmakro Anzeige Userform
DaET1 = Now + DaZeit1 ' Zeit für das schließen der Datei festlegen
Application.OnTime DaET1, "Schließen" ' Makro zum festgelegten Zeitpunkt starten
SetActiveWindow FindWindow("xlMain", vbNullString)
frm_Abfrage.Show ' UserForm starten
End Sub
Sub Schließen()
'Unload UserForm1
If BoZu = False Then
ThisWorkbook.Save ' Datei speichern
' falls nur eine Datei auf Excel schließen
' ess erfolgt eine Abfrage zum speichern
If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End If
End Sub
Sub Zeitabstand() ' Makro für laufende Zeit in UserForm
With frm_Abfrage
' neue Zeit auf das Label schreiben
.LbL_Zeit.Caption = "Restzeit: " & CDate(CDate(Application.Substitute(.LbL_Zeit.Caption, "Restzeit: ", "")) - DaZeit2)
' Prüfen ob Zeit abgelaufen ist
If CDate(Right(.LbL_Zeit.Caption, 8)) > 0 Then
DaET2 = Now + DaZeit2 ' neue Startzeit setzen
Application.OnTime DaET2, "Zeitabstand" ' Makro zum festgelegten Zeitpunkt starten
End If
End With
End Sub
wäre das so richtig? Ich muss das noch auf den Rechnern mit dem alten Excel testen....
Moin!
Wenn Du die Datei hochgeladen hättest, hätten wir das testen können.
Übrigens:
64 Bit ist keinesfalls das "bessere" oder "neuere" Excel!
Selbst MS empfiehlt mit sehr wenigen Ausnahmen 32 Bit: http://www.online-excel.de/excel/singsel.php?f=186
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Das war damit nicht gemeint, dass 64 besser ist... ich hab es nun mal schon auf der Arbeit auf dem Rechner. Die Kollegen die es betrifft aber noch nicht....
