Ich bin ganz nah an der optimalen Lösung, aber die Funktion
Application.OnTime führt nach dem ersten Aufruf immer zu der
Fehlermeldung:
"Das Makro Dateiname!AutoUpdate kann nicht gefunden werden!"
Ich kann mir wirklich nicht erklären woran das liegt,
da ich schon alle mögliche Varianten ausprobiert habe :-(
Vielen Dank im Voraus für Eure Hilfe
Den Code habe ich beigefügt!
MfG
Frank
DER QUELLTEXT [TEILWEISE]
Sub StartAutoUpdate()
gdNextTime = Now + TimeSerial(0, 0, giIntervall)
Application.OnTime _
EarliestTime:=gdNextTime, _
Procedure:="AutoUpdate", _
Schedule:=True
End Sub
Private Sub AutoUpdate()
On Error GoTo ERRORHANDLER
saveTimerStarted = True
countUpdate = countUpdate + 1
MsgBox "countUpdate: " & countUpdate
If ActiveWorkbook.ReadOnly = True Then
ActiveWorkbook.UpdateFromFile
Else
If Not lastModifiedTime = FileDateTime(ActiveWorkbook.FullName) Then
'Save führt zur aktualisierten Anzeige
'aller MultiUserEditing-Änderungen
ActiveWorkbook.Save
lastModifiedTime = FileDateTime(ActiveWorkbook.FullName)
End If
End If
Call StartAutoUpdate
ERRORHANDLER
MsgBox "Datei konnte nicht aktualisiert werden"
End Sub
DER QUELLTEXT [VOLLSTÄNDIG]
Dim blnAutoSaveChanges As Boolean
Dim autoSaveFrage As String
Dim multiEditFrage As String
Dim saveTimerStarted As Boolean
Dim saveTimerNextStart As Date
Dim gdNextTime As Double
Dim giIntervall As Integer
Dim lastModifiedTime As Date
Dim countUpdate As IntegerPrivate Sub Workbook_Open()
lastModifiedTime = FileDateTime(ActiveWorkbook.FullName)
giIntervall = 10
blnAutoSaveChanges = False
saveTimerStarted = False
countUpdate = 0
multiEditFrage = "Möchten Sie das Dokument zur gleichzeitigen Bearbeitung"
multiEditFrage = multiEditFrage & vbCr & " für mehrere Benutzer freigen?"
autoSaveFrage = "Möchten Sie Änderungen automatisch speichern lassen?"
MsgBox "activeworkbook.ReadOnly:" & ActiveWorkbook.ReadOnly
If ActiveWorkbook.ReadOnly = False Then
If Not ActiveWorkbook.MultiUserEditing Then
If MsgBox(multiEditFrage, vbYesNo, "MultiUserEdit?") = vbYes Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, _
AccessMode:=xlShared
End If
End If
If ActiveWorkbook.MultiUserEditing Then
If MsgBox(autoSaveFrage, vbYesNo, "AutoSave?") = vbYes Then
blnAutoSaveChanges = True
ActiveWorkbook.AutoUpdateFrequency = 5
ActiveWorkbook.AutoUpdateSaveChanges = False
Else
ActiveWorkbook.AutoUpdateFrequency = 5
ActiveWorkbook.AutoUpdateSaveChanges = True
End If
End If
End If
StartAutoUpdate
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveWorkbook.ReadOnly = True Then
If ActiveWorkbook.MultiUserEditing Then
If blnAutoSaveChanges = True Then
ActiveWorkbook.Save
lastModifiedTime = FileDateTime(ActiveWorkbook.FullName)
End If
End If
End If
End Sub
Sub StartAutoUpdate()
gdNextTime = Now + TimeSerial(0, 0, giIntervall)
Application.OnTime _
EarliestTime:=gdNextTime, _
Procedure:="AutoUpdate", _
Schedule:=True
End Sub
Private Sub AutoUpdate()
On Error GoTo ERRORHANDLER
saveTimerStarted = True
countUpdate = countUpdate + 1
MsgBox "countUpdate: " & countUpdate
If ActiveWorkbook.ReadOnly = True Then
ActiveWorkbook.UpdateFromFile
Else
If Not lastModifiedTime = FileDateTime(ActiveWorkbook.FullName) Then
'Save führt zur aktualisierten Anzeige
'aller MultiUserEditing-Änderungen
ActiveWorkbook.Save
lastModifiedTime = FileDateTime(ActiveWorkbook.FullName)
End If
End If
Call StartAutoUpdate
ERRORHANDLER
MsgBox "Datei konnte nicht aktualisiert werden"
End Sub