Tabelle nur einmal speichern

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
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

Beiträge aus den Excel-Beispielen zum Thema "Tabelle nur einmal speichern"