AW: Liste mit Makro erstellen
19.09.2007 12:35:00
fcs
Hallo Bejamin,
da du in deiner Eingangsfrage nur den Zeitpunkt des Klicks in die Dateien schreiben wolltest, wird natürlich auch nur dieser in die Dateien geschrieben.
Mit folgenden Ergänzungen kannst du auch einen weiteren Wert in die Dateien schreiben.
Warum konntest du deine Wünsche eigentlich nicht in der 1. Frage komplett beschreiben?
Gruß
Franz
Private Sub CommandButton1_Click()
Dim ZeitPunkt As Date, wbTest As Workbook, wertA1, strDatei, boDateioffen As Boolean
On Error GoTo Fehler
ZeitPunkt = Now
Application.ScreenUpdating = False
'Wert aus Datei, 1. Tabelle , Zelle A1 einlesen
strDatei = "C:\Test\Test.xls"
'Prüfung ob Datei geöffnet
For Each wbTest In Workbooks
If wbTest.FullName = strDatei Then
boDateioffen = True
Exit Sub
End If
Next
If wbTest Is Nothing Then
Set wbTest = Workbooks.Open(FileName:=strDatei, ReadOnly:=True)
End If
wertA1 = wbTest.Worksheets(1).Range("A1").Value
If boDateioffen = False Then
wbTest.Close savechanges:=False
End If
'Zeitpukt der Button-Betätigung in Excel-Datei speichern
Call ZeitPunktXLS(DatumZeit:=ZeitPunkt, _
DateiName:="C:\Test\ButtonKlickZeit.xls", Liste:=False, Wert2:=wertA1)
Call ZeitPunktXLS(DatumZeit:=ZeitPunkt, _
DateiName:="C:\Test\ButtonKlickZeitListe.xls", Liste:=True, Wert2:=wertA1)
'Zeitpukt der Button-Betätigung in Text-Datei speichern
' Call ZeitPunktTXT(DatumZeit:=ZeitPunkt, _
DateiName:="C:\Test\ButtonKlickZeit.txt", Liste:=False, Wert2:=wertA1)
' Call ZeitPunktTXT(DatumZeit:=ZeitPunkt, _
DateiName:="C:\Test\ButtonKlickZeitListe.txt", Liste:=True, Wert2:=wertA1)
Application.ScreenUpdating = True
GoTo Beenden
Fehler:
MsgBox "Fehler Nr.: " & Err.Number & " ist aufgetreten!" & vbLf & vbLf & Err.Description
Beenden:
'Objektvariablen zurücksetzen
Set wbTest = Nothing
End Sub
Sub ZeitPunktXLS(DatumZeit As Date, DateiName As String, Liste As Boolean, Wert2)
'Zeitpunkte des Buttonklicks in Excel-Dateien speichern
Dim wb As Workbook, wks As Worksheet
On Error GoTo Fehler
Set wb = Workbooks.Open(FileName:=DateiName)
Set wks = wb.Worksheets(1)
If Liste = False Then
wks.Range("A2") = DatumZeit
wks.Range("B2") = Wert2
Else
With wks
'Datum Zeit in Spalte A in nächster freier Zeile eintragen
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = DatumZeit
'Wert2 neben Datum Zeit in Spalte B eintragen
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1).Value = Wert2
End With
End If
wb.Close savechanges:=True
GoTo Beenden
Fehler:
MsgBox "Fehler Nr.: " & Err.Number & " ist aufgetreten!" & vbLf & vbLf & Err.Description
Beenden:
'Objektvariablen zurücksetzen
Set wks = Nothing
Set wb = Nothing
End Sub
Sub ZeitPunktTXT(DatumZeit As Date, DateiName As String, Liste As Boolean, Wert2)
'Zeitpunkte des Buttonklicks und Wert2 in Text-Dateien speichern (Tab als Trennzeichen)
Dim FreeNr As Byte, TZ
On Error GoTo Fehler
TZ = vbTab 'Trennzeichen in Textdatei
FreeNr = FreeFile
If Liste = False Then
Open DateiName For Output As #FreeNr
Print #FreeNr, "ZeitPunkt Letzter Klick" & TZ & "Wert2"
Else
Open DateiName For Append As #FreeNr
End If
Print #FreeNr, Format(DatumZeit, "DD.MM.YYYY hh:mm:ss") & TZ & Wert2
Close #FreeNr
Exit Sub
Fehler:
MsgBox "Fehler Nr.: " & Err.Number & " ist aufgetreten!" & vbLf & vbLf & Err.Description
Close #FreeNr
End Sub