Herbers Excel-Forum - das Archiv

Tabelle nur einmal speichern

Bild

Betrifft: Tabelle nur einmal speichern
von: Rene

Geschrieben am: 10.04.2005 09:58:34
Moin zusammen,
Weiß nicht ob der Betreff richtig ist, Ich habe diesen Code:
Option Explicit
Declare
Function GetVolumeInformationA Lib "kernel32" _
(ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
Sub Festplatte_und_UserName_speichern() 'speichern unter Workbook BeforeClose
Dim SerialNumber As Long
Dim Username As String
GetVolumeInformationA "C:\", vbNullString, 0, SerialNumber, _
0, 0, vbNullString, 0
Sheets("Daten").Range("B2") = SerialNumber 'ließt Festplattennummer aus
Sheets("Daten").Range("C2") = Application.Username   ' ließt Username aus
End Sub


Sub Festplatte_und_UserName_lesen() 'speichern unter Workbook Open
Dim SerialNumber As Long
Dim Username As String
Dim Text As String
Dim A As String
GetVolumeInformationA "C:\", vbNullString, 0, SerialNumber, _
0, 0, vbNullString, 0
Sheets("Daten").Range("D2") = SerialNumber 'ließt Festplattennummer aus
Sheets("Daten").Range("E2") = Application.Username   ' ließt Username aus
If Sheets("Daten").Range("B2") = Sheets("Daten").Range("D2") And Sheets("Daten").Range("C2") = Sheets("Daten").Range("E2") Then
Sheets("Daten").Range("D2,E2").Delete
Else
Text = "Du versuchst diese Tabelle auf einem anderen Rechner zu öffnen!!!"
Text = Text & vbCrLf & "Dieses geht NICHT!!!"
Text = Text & vbCrLf & ""
Text = Text & "Diese Tabelle kann nur da geöffnet werden wo sie das erste mal geöffnet wurde."
Text = Text & vbCrLf & vbCrLf & "Diese Tabelle wird nun geschlossen."
A = MsgBox(Text, vbOKOnly + vbExclamation)
'ThisWorkbook.Close
End If
End Sub

Nun wollte ich mit diesem Code erreichen das der Username und die Festplattennummer gespeichert wird dieses geht ja auch. Wenn mann nun die Tabelle schließt
(hier z.B. wird mein Name und meine Nummer) gespeichert,öffne ich nun die Tabelle auf einem anderen Rechner kommt natürlich die Fehlermeldung und die Tabelle wird geschlossen
(ist aber noch aus) so soll es ja auch sein.Öffnet man aber nun diese Tabelle ein zweites mal schreibt es natürlich die neue Nummer und den Namen rein und mann kann wieder mit arbeiten.
Wie bekomme ich das nun hin das man die Tabelle nur jeweils einmal öffnen kann (auf ca.15 Rechnern)?
Der Username und Nummer schreibt sich dabei ein,kann es sein das man die Tabelle nur einmal speichern darf oder die Daten beim schließen wieder löschen muß?
Ich hoffe das ihr verstanden habt wie ich es meine.
Gruß Rene
Bild

Betrifft: AW: Tabelle nur einmal speichern
von: Ramses

Geschrieben am: 10.04.2005 10:25:36
Hallo
probiers mal so
Option Explicit
Declare
Function GetVolumeInformationA Lib "kernel32" _
(ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
'Der Code ist völlig unnötig
Sub Festplatte_und_UserName_speichern() 'speichern unter Workbook BeforeClose
Dim SerialNumber As Long
Dim Username As String
Dim chkWks As Worksheet
Set chkWks = Worksheets("Daten")
GetVolumeInformationA "C:\", vbNullString, 0, SerialNumber, 0, 0, vbNullString, 0
With chkWks
If IsEmpty(.Range("B2")) And IsEmpty(.Range("D2")) Then
.Range("B2") = SerialNumber
'Das taugt nix zur Prüfung
'weil es von jedem User unter "Extras - Optionen" geändert werden kann
.Range("D2") = Application.Username
End If
End With
End Sub

'Bis hier
'*******************************
Sub Festplatte_und_UserName_lesen() 'speichern unter Workbook Open
Dim SerialNumber As Long
Dim Username As String
Dim Text As String
Dim A As String
Dim chkWks As Worksheet
Set chkWks = Worksheets("Daten")
GetVolumeInformationA "C:\", vbNullString, 0, SerialNumber, 0, 0, vbNullString, 0
With chkWks
If IsEmpty(.Range("B2")) And IsEmpty(.Range("D2")) Then
.Range("B2") = SerialNumber
'Das taugt nix zur Prüfung
'weil es von jedem User unter "Extras - Optionen" geändert werden kann
.Range("D2") = Application.Username
'Gleich speichern
ThisWorkbook.Save True
Else
If SerialNumber <> .Range("B2") Then
Text = "Du versuchst diese Tabelle auf einem anderen Rechner zu öffnen!!!"
Text = Text & vbCrLf & "Dieses geht NICHT!!!"
Text = Text & vbCrLf & ""
Text = Text & "Diese Tabelle kann nur da geöffnet werden wo sie das erste mal geöffnet wurde."
Text = Text & vbCrLf & vbCrLf & "Diese Tabelle wird nun geschlossen."
A = MsgBox(Text, vbOKOnly + vbExclamation)
'Aktivieren
'ThisWorkbook.Close
End If
End With
End Sub

Das Worksheet("Daten") muss natürlich mit VBA auf "xlVeryHidden" gesetzt werden und das VB-Projekt geschützt werden. Ein Zugriff auf die Tabelle ohne aktivierte Makros muss natürlich ebenso verhindert werden, ansonsten der ganze Code hier völlig sinnlos ist.

"....Wie bekomme ich das nun hin das man die Tabelle nur jeweils einmal öffnen kann (auf ca.15 Rechnern)? ..."
Schreib die Festplattennmummern in die Spalte B, prüfe bei jedem öffnen ob die Anzahl der eingetragenen Festplattennummern kleiner 16 ist und das wars dann.
Gruss Rainer
Bild

Betrifft: Kleine Korrektur..
von: Ramses

Geschrieben am: 10.04.2005 10:36:35
Hallo
Eine "End If" Anweisung vergessen in dem Segment
Sub Festplatte_und_UserName_lesen() 'speichern unter Workbook Open
Dim SerialNumber As Long
Dim Username As String
Dim Text As String
Dim A As String
Dim chkWks As Worksheet
Set chkWks = Worksheets("Daten")
GetVolumeInformationA "C:\", vbNullString, 0, SerialNumber, 0, 0, vbNullString, 0
With chkWks
If IsEmpty(.Range("B2")) And IsEmpty(.Range("D2")) Then
.Range("B2") = SerialNumber
'Das taugt nix zur Prüfung
'weil es von jedem User unter "Extras - Optionen" geändert werden kann
.Range("D2") = Application.Username
'Gleich speichern
ThisWorkbook.Save
Else
If SerialNumber <> .Range("B2") Then
Text = "Du versuchst diese Tabelle auf einem anderen Rechner zu öffnen!!!"
Text = Text & vbCrLf & "Dieses geht NICHT!!!"
Text = Text & vbCrLf & ""
Text = Text & "Diese Tabelle kann nur da geöffnet werden wo sie das erste mal geöffnet wurde."
Text = Text & vbCrLf & vbCrLf & "Diese Tabelle wird nun geschlossen."
A = MsgBox(Text, vbOKOnly + vbExclamation)
'Aktivieren
'ThisWorkbook.Close
End If
End If
End With
End Sub

Gruss Rainer
Bild

Betrifft: AW: Tabelle nur einmal speichern
von: Rene

Geschrieben am: 10.04.2005 10:46:02
Moin Rainer,
Habe es probiert er gibt mir aber bei dieser Zeile: "ThisWorkbook.Save True"
Falsche Anzahl an Argumenten. Was kann das sein. Wegen den Rechner ich weiß doch aber noch gar nicht wie die Nummern der Platten sind, also müßte er doch selber immer die Nummern der Platten vergleichen, denn die Rechner sind ja unterschiedlich und es darf die Tabelle nur jeweils auf einem Rechner geöffnet werden. Ich möchte damit so halbwegs umgehen das man die Tabelle kopieren kann und auf einem anderen Rechner öffnet als wo sie das erste mal geöffnet wurde. Es klingt zwar sehr verwirrend aber ich hoffe du verstehst mich wie ich das meine.
Gruß Rene
Bild

Betrifft: AW: Tabelle nur einmal speichern
von: Ramses

Geschrieben am: 10.04.2005 11:16:17
Hallo
deshalb auch die kleine Korrektur.
Verwende den anderen Code der läuft. Die Option "True" von Workbook Save ist zuviel.
Alles andere kannst du vergessen.
Woher willst du denn wissen, auf wievielen Rechner die Datei installiert war.
Wenn die Rechner untereinander keinen Zugriff auf einen gemeinsam nutzbaren Datenspeicher haben, den du verwenden kannst um die Seriennummern der Rechner, auf denen die Datei "geöffnet" wurde, zu speichern, hast du keinerlei Kontrollmöglichkeit.
Du kannst nur eine einmal geöffnete Datei kontrollieren, aber nicht wie oft die Datei insgesamt schon in einem Netzwerk oder auf verschiedenen Rechnern geöffnet wurde.
Gruss Rainer
Bild

Betrifft: AW: Tabelle nur einmal speichern
von: Rene
Geschrieben am: 10.04.2005 12:25:05
Hi Rainer,
Ok, Danke dir nochmal werde es nacher nochmal testen.Muß erst mal aufhören bekomme sonst mit meiner Frau heute noch ordentlich ärger wegen den sch... Computern.
Melde mich heute abend nochmal.
Gruß Rene
Bild

Betrifft: So würde es ERST mal gehen!
von: Rene

Geschrieben am: 10.04.2005 13:52:00
Hi Rainer,
Konnte es doch nicht bis heute Abend abwarten,habe es probiert und so geht es prima.
Das mit dem Namen habe ich zwar erst nicht verstanden,habe es dann aber auch gefunden.
Das mit den Tabellen ist so: Ich gebe in meiner Firma die Tabelle(als Beispiel 15 mal)an verschiedene Benutzer weiter.Jeder öffnet nun diese Tabelle auf seinem Rechner das erstemal und nun tritt ja dein Code in Aktion mann kann also diese Tabelle auch nur noch auf dem Rechner öffnen wo man sie das erste mal geöffnet hat.(Wenn man sich denkt jetzt habe ich die Tabelle nun kann ich sie mir kopieren und auch auf einem anderen Rechner öffnen,geht aber nicht weil ja die Festplattennummer gespeichert ist.)Aber nun hätte ich doch nochmal eine Frage, wenn ich nun diese Tabelle als "halber" Programmierer auf meinem Rechner selber öffnen will(kann ja immer mal sein) würde dieses ja auch nicht gehen,da die Tabelle ja gleich wieder schließt wie könnte ich denn das damit einbauen das ich z.B. ein Kennwort eingebe und ich dann trotzdem die Tabelle öffnen kann? Hättest du da ein Idee?
Gruß Rene
Bild

Betrifft: AW: So würde es ERST mal gehen!
von: Ramses

Geschrieben am: 10.04.2005 13:55:46
Hallo
du wirst ja wohl eine Sicherungskopie oder die Originaldatei haben.
Weshalb solltest du eine andere Datei öffnen müssen ?
Schau mal 2 Beiträge oberhalb "Passwortabfrage"
Das kannst du einbauen.
Anstelle Blattschutz entfernen dann halt die Festplatteneinträge löschen.
Gruss Rainer
Bild

Betrifft: AW: So würde es ERST mal gehen!
von: Rene
Geschrieben am: 10.04.2005 14:01:37
Hi Rainer,
Thx werde ich mal versuchen.Danke dir nochmal für deine Hilfe.
Gruß Rene
 Bild
Excel-Beispiele zum Thema "Tabelle nur einmal speichern"
Suche über mehrere Tabellen Benennen von Tabellenblättern mit Monatsnamen
Druckseitenlinien im Tabellenblatt Tabellenblattnamen in ein Listenfeld einlesen
Suchbegriff über mehrere Tabellenblätter suchen. Tabellenblätter benennen
Tabellenblatt auswählen Zustand von Tabellenblatt-Checkboxes ermitteln
Tabellenblattnamen der VBE-Projekte ändern Tabellenblattnamen nach Datum