Excel Makros D

Problem

Makro

Dateipfad in Kopfzeile eintragen

Sub PfadInKopfzeile()
Worksheets(1).PageSetUp.LeftHeader = ThisWorkbook.Fullname
End Sub

prüfen, ob Datei vorhanden

If Dir("c:\test.xls") <> "" Then
MsgBox "Datei vorhanden"
Else
MsgBox "Datei fehlt"
End If

von Bernd Held:

Function FileExist(Filename As String) As Boolean
   FileExist = False
   If Len(Filename) > 0 Then FileExist = (Dir(Filename) <> "")
   Exit Function
End Function

Sub DateiDa()
s = FileExist("C:\eigene Dateien\Mappe.xls")
MsgBox s
End Sub

Dateien eines Verzeichnisses auflisten

'Aus der Onlinehilfe von Excel2000 mit kleinen Anpassungen:

Sub Dateien_auflisten()
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("c:\temp")
Set fc = f.Files
i = 0
For Each f1 In fc
i = i + 1
ActiveSheet.Cells(i, 1) = f1.Name
ActiveSheet.Cells(i, 2) = FileLen(f1)
ActiveSheet.Cells(i, 3) = FileDateTime(f1)
Next
End Sub

Dateiattribute ändern

Sub Dateiattribut()
ChDir "C:\"
DATEI = "C:\Temp\Test.xls"
SetAttr DATEI, vbNormal
End Sub

Weitere Attribute:

vbNormal	0	Normal (Voreinstellung)
vbReadOnly	1	Schreibgeschützt
vbHidden	2	Versteckt
vbSystem	4	Systemdatei
vbArchive	32	Datei wurde seit dem letzten Speichern geändert

Dateien auf Festplatte löschen

Sub löschen()
ChDir "c:\"
Kill ("c:\temp\test.doc")
End Sub

Diskette in Laufwerk A

'von Bernd Held

Sub DisketteDrin()
Dim s as string
    On Error Resume Next
    If IsError(s = Dir("a:\", vbVolume)) = True Then
        MsgBox "Bitte eine Diskette einlegen!"
        Exit Sub
    End If
End Sub

größter Dateiname eines Textdokuments
(Zahlenwert)

Textdokumente in c:\Temp abgespeichert als 0001.txt, 0002.txt usw.
Andere Dateiendungen werden ignoriert.

Sub GrößteDateiNummer()
Dim fs, f, f1, fc, gf
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("c:\temp")
Set fc = f.Files
gf = 0
For Each f1 In fc
If Left(f1.Name, Len(f1.Name) - 4) > gf _
And IsNumeric(Left(f1.Name, Len(f1.Name) - 4)) _
And Right(f1.Name, 4) = ".txt" Then
gf = Left(f1.Name, Len(f1.Name) - 4)
End If
Next
MsgBox "Der höchste Dateiname lautet: " & gf
End Sub

Zahl in Datum umwandeln

Zahlen
10901 in 01.09.2001
bzw.
310801 in 31.08.2001
des selektierten Bereichs

Sub ZahlInDatum()
Dim c As Range
On Error Resume Next
For Each c In Selection
If Len(c) = 5 Then
c = DateSerial(Right(c, 2), Mid(c, 2, 2), Left(c, 1))
End If
If Len(c) = 6 Then
c = DateSerial(Right(c, 2), Mid(c, 3, 2), Left(c, 2))
End If
Next c
End Sub

Datum von Textbox als "richtiges" Datum zurückgeben

............
[a1]=datevalue(textbox1.text)
............

Meine aktuellsten Exceltipps finden Sie hier: