habe ich es tatsächlich geschafft oder hat sich ein böser Denkfehler eingeschlichen?
Mein Ziel ist es, eine Datei gleichzeitig von mehreren Usern zu bearbeiten.
Ich habe eine freigegebene Tabelle. Beim Öffnen wird der Username in tblUser eingetragen. In die Userform werden die Daten eingetragen und mit cmdFertig in die nächste leere Zeile von tblDaten eingetragen und gespeichert. Wenn jetzt zwei oder mehr User die Datei geöffnet haben, jeder Username steht dann in tblUser, wird nicht die nächste leere Zeile verwendet, sondern die Zeile LetzterEintrag + AnzahlUser. Dabei können auch leere Zeilen entstehen, d. h. wenn ein User ständig online ist und ein anderer neue Einträge macht. Ist ein User als einziger angemeldet, werden diese leeren Zeilen entfernt.
Und hier der Code:
DieseArbeitsmappe
Sub Workbook_Open()
Dim ErsteLeereZeile As Integer
Worksheets("tblUser").Activate
ErsteLeereZeile = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Cells(ErsteLeereZeile, 1) = Environ("Username")
ThisWorkbook.Save
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Schliessen
ThisWorkbook.Save
End Sub
Userform1
Private Sub cmdAbbrechen_Click()
Unload Me
End Sub
Private Sub cmdFertig_Click()
Dim LeereZeile As Integer
Dim AnzahlUser As Double
Dim i As Long
AnzahlUser = Application.WorksheetFunction.CountIf(Range("anzahleintraege"), "<>")
Worksheets("tblDaten").Activate
If AnzahlUser = 1 Then
LeereZeilenLöschen
End If
LeereZeile = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row + AnzahlUser
Cells(LeereZeile, 1) = TextBox1
Cells(LeereZeile, 2) = TextBox2
Cells(LeereZeile, 3) = TextBox3
Cells(LeereZeile, 4) = Environ("Username")
ThisWorkbook.Save
Unload Me
Application.Quit
End Sub
Sub LeereZeilenLöschen()
Dim i As Long
maxrow = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Row
For i = 1 To maxrow
If WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).Delete
End If
Next
End Sub
Modul1
Option Explicit
Sub Schliessen()
Worksheets("tblUser").Activate
Dim LetzterEintrag As Integer
LetzterEintrag = Cells(Cells.Rows.Count, 1).End(xlUp).Row
Cells(LetzterEintrag, 1).ClearContents
End Sub
Tabelle1
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
Ist es so möglich? oder gehts einfacher?
Was ist eure Meinung?
Und tschüß
andi