Excel-Datei nur einmal öffnen
Markus Maurer
Wie kann ich erreichen, dass ich eine Exel-Datei nur einmal öffnen kann
?
Die Datei soll von anderen Benutzern auch nicht schreibgeschützt
geöffnet werden.
Vielen Dank.
Markus Maurer
Michael Schüller
"Markus Maurer" <markus...@web.de> schrieb im Newsbeitrag
news:3C5AB517...@web.de...
>
> Wie kann ich erreichen, dass ich eine Exel-Datei nur einmal öffnen kann
> ?
>
> Die Datei soll von anderen Benutzern auch nicht schreibgeschützt
> geöffnet werden.
>
Es gibt zwei Möglichkeiten, das zu realisieren.
Die erste hat den Nachteil, dass die Excel-Datei in bestimmten Abständen
gespeichert wird. Wenn also ein Anwender Unsinn in der Excel-Datei eingibt,
wird dieser Unsinn auch in den o.g. bestimmten Abständen gespeichert. Das
ist auch ungünstig, wenn die Datei sehr groß ist.
Die zweite halte ich für besser, hat aber wiederum den Nachteil, dass eine
"Sperrdatei" angelegt wird. Wird diese von irgend jemand gelöscht, ist Deine
Excel-Datei nicht mehr gesperrt. Im untenstehenden Code habe wird die
"Sperrdatei" im Pfad der Excel-Datei angelegt, Du kannst sie aber natürlich
auch irgendwo anders anlegen, was das Risiko des (un)absichtlichen Löschens
verringert.
Beide Lösungen sorgen dafür, dass alle 60 Sekunden ein "Datums-Stempel"
gesetzt wird. Dieser Datumsstempel wird beim Öffnen der Excel-Datei geprüft.
Wenn der Datums-Stempel innerhalb der letzten 70 Sekunden (10 Sekunden
Kulanz) gesetzt wurde, wird die Datei automatisch geschlossen. Ist das nicht
der Fall, wird der Datumsstempel gesetzt.
1. Lösung:
In VBA - "Diese Arbeitsmappe" einfügen:
Private Sub Workbook_Open()
If ThisWorkbook.Sheets(1).[A1] + TimeValue("00:01:10") > Now Then
MsgBox "Gesperrt!"
ThisWorkbook.Close SaveChanges:=False
Else
Call Sperren
End If
End Sub
In ein Modul einfügen:
Public Sub Sperren()
ThisWorkbook.Sheets(1).[A1] = Now
ThisWorkbook.Save
Application.OnTime Now + TimeValue("00:01:00"), "Sperren"
End Sub
2. Lösung:
In VBA - "Diese Arbeitsmappe" einfügen:
Private Sub Workbook_Open()
Dim vSperrFile As String
Dim vDNr As Integer
Dim vZeit As String
Dim vSperrFileExists As Boolean
vSperrFile = ThisWorkbook.Path & "\Sperre.txt"
vDNr = FreeFile
On Error Resume Next
Open vSperrFile For Input As vDNr
vSperrFileExists = Err.Number = 0
On Error GoTo 0
If vSperrFileExists Then
Input #vDNr, vZeit'Zeit einlesen, bis zu der die Datei gesperrt ist
Close vDNr
If CDate(vZeit) > Now Then'wenn die Sperrzeit noch nicht erreicht ist,
Datei schließen
MsgBox "Gesperrt!"
ThisWorkbook.Close SaveChanges:=False
End If
End If
'Datei sperren, falls Sperrdatei nicht existiert oder Sperrzeit abgelaufen
Call Sperren
End Sub
In ein Modul einfügen:
Public Sub Sperren()
Dim vSperrFile As String
Dim vDNr As Integer
vSperrFile = ThisWorkbook.Path & "\Sperre.txt" 'ggf. hier einen anderen Pfad
angeben
vDNr = FreeFile
Open vSperrFile For Output As vDNr
Print #vDNr, Now + TimeValue("00:01:00")'aktuelle Zeit + 1 Minute als
Sperrzeit festlegen
Close vDNr
Application.OnTime Now + TimeValue("00:01:00"), "Sperren" 'in einer Minute
Sperrzeit aktualisieren
End Sub
Ich hoffe, das hilft Dir weiter.
Gruß
--
Michael
michael....@gmx.de
Sonnenradl
es gibt doch auch die gemeinsame bearbeitung, der MASTER kann die änderungen
zulassen, oder ablehnen. da ich das noch nicht getestet habe, nur soviel:
stichwort: arbeitsmappe freigeben.
die oh ist dort eigentlich recht gut.
gruss
S.R.
Günther Heitzendorfer
die super-lösung, die auch im netzwerk funktioniert ist zwar nicht von mir,
habe sie aber schon lange und oft eingesetzt. der code frägt nur ab, ob die
datei schreibgeschützt (wenn sie bereits geöffnet ist) ist.
wenn ja, wird die kopie (unsichtbar) wieder geschlossen und die meldung
ausgegeben.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Object
Set wb = Workbooks.Open("D:\Daten\Deinedatei.xls", ReadOnly:=False)
Application.DisplayAlerts = True
If wb.ReadOnly = True Then
wb.Close savechanges:=False
MsgBox "Datei wird gerade bearbeitet"
Exit Sub
End If
gruß
günther
"Markus Maurer" <markus...@web.de> schrieb im Newsbeitrag
news:3C5AB517...@web.de...
>
georg2...@gmail.com
Application.DisplayAlerts = False
Dim wb As Object
If wb.ReadOnly = True Then
wb.Close savechanges:=False
MsgBox "Datei wird gerade bearbeitet"
Exit Sub
End If
Grüße
Georg
