Sub TextDateiErstellen2()
Dim exportfile$, TB As Worksheet, z%, TMP$
exportfile = "C:\test.txt"
Dateinummer = FreeFile
Set TB = ThisWorkbook.ActiveSheet
'Die folgende Zeile erzeugt eine neue Datei mit dem angegebenen Namen
'im angegebenen Pfad
Open exportfile For Output As #Dateinummer
'Die beiden Schleifen beziehen alle belegten Zellen in die zu erstellende Textdatei ein
For z = 1 To TB.UsedRange.Rows.Count
For s = 1 To TB.UsedRange.Columns.Count
'Das Semikolon ist durch jedes beliebige Feldtrennzeichen ersetzbar
TMP = TMP & CStr(TB.Cells(z, s).Text) & ";"
Next s
'Damit am Ende jeder Zeile, also nach der letzten Zelle kein Strichpunkt mehr gesetzt wird,
'muss das letzte Zeichen wieder abgezogen werden
TMP = Left(TMP, Len(TMP) - 1)
'Print fügt hier immer eine Zeile zur bestehenden Textdatei hinzu
Print #Dateinummer, TMP
'Die Variable TMP muss vor der Aufnahme der nächsten Zeile wieder geleert werden
TMP = ""
Next z
Close #Dateinummer
End Sub
Sub CSV()
Dim vorigeZelle As Range
Set vorigeZelle = ActiveCell
Application.ScreenUpdating = True
Application.DisplayAlerts = False
'Passwort abfragen
Passwort = InputBox("Passwort?")
If Passwort <> "Chef" Then Exit Sub
'Leerzeilen in der Holzliste löschen Bezugszelle ist Stückzahl (Spalte E)
Dim LgZ%, LZ As Double, X%
With Worksheets("Holzliste").Range("E5")
LgZ = Cells(Rows.Count, 5).End(xlUp).Row
For X = 5 To LgZ
On Error Resume Next
If Not IsEmpty(Cells(X, 5)) And Cells(X, 5) <> 0 Then
Else: Exit For
End If
Next X
LgZ = X
LZ = Rows.Count
End With
Rows((LgZ) & ":" & (LZ)).EntireRow.Delete Shift:=xlUp
Columns("BE:FG").Select
Selection.Delete Shift:=xlToLeft
'TabellenblätterLöschen()
Dim Arbeitsblatt As Worksheet
For Each Arbeitsblatt In Worksheets
If Arbeitsblatt.Name = "Holzliste" Then
Arbeitsblatt.Visible = xlSheetVisible
Else: Arbeitsblatt.Delete
End If
Next Arbeitsblatt
'SpeichernUnter()
Speicher = InputBox("Speicher Name : ")
Dim DName, Dateiname, Pfad
Pfad = "C:\v71\LISTEN"
DName = Speicher
Dateiname = Pfad & "\" & DName & ".csv"
ThisWorkbook.SaveAs Filename:=Dateiname, FileFormat:= _
xlCSV
'Excel in Taskleiste legen
Application.WindowState = xlMinimized
'Workbook schließen
ActiveWorkbook.Close
Application.DisplayAlerts = True
vorigeZelle.Select
End Sub
Sub CSV()
Dim vorigeZelle As Range, Passwort$
Dim LgZ%, LZ As Double, X%
Dim Arbeitsblatt As Worksheet
Dim DName, Dateiname, Pfad
Dim TB As Worksheet, z%, TMP$, Dateinummer%
Set vorigeZelle = ActiveCell
Application.ScreenUpdating = True
Application.DisplayAlerts = False
'Passwort abfragen
Passwort = InputBox("Passwort?")
If Passwort <> "Chef" Then Exit Sub
'Leerzeilen in der Holzliste löschen Bezugszelle ist Stückzahl (Spalte E)
' With Worksheets("Holzliste").Range("E5")
LgZ = Cells(Rows.Count, 5).End(xlUp).Row
For X = 5 To LgZ
On Error Resume Next
If Not IsEmpty(Cells(X, 5)) And Cells(X, 5) <> 0 Then
Else: Exit For
End If
Next X
LgZ = X
LZ = Rows.Count
' End With
Rows((LgZ) & ":" & (LZ)).EntireRow.Delete Shift:=xlUp
Columns("BE:FG").Delete Shift:=xlToLeft
'TabellenblätterLöschen()
For Each Arbeitsblatt In Worksheets
If Arbeitsblatt.Name = "Holzliste" Then
Arbeitsblatt.Visible = xlSheetVisible
Else: Arbeitsblatt.Delete
End If
Next Arbeitsblatt
'SpeichernUnter()
Speicher = InputBox("Speicher Name : ")
Pfad = "C:\v71\LISTEN"
DName = Speicher
Dateiname = Pfad & "\" & DName & ".csv"
' ThisWorkbook.SaveAs Filename:=Dateiname, FileFormat:= xlCSV
Dateinummer = FreeFile
Set TB = ThisWorkbook.ActiveSheet
'Die folgende Zeile erzeugt eine neue Datei mit dem angegebenen Namen
'im angegebenen Pfad
Open Dateiname For Output As #Dateinummer
'Die beiden Schleifen beziehen alle belegten Zellen in die zu erstellende Textdatei ein
For z = 1 To TB.UsedRange.Rows.Count
For s = 1 To TB.UsedRange.Columns.Count
'Das Semikolon ist durch jedes beliebige Feldtrennzeichen ersetzbar
TMP = TMP & CStr(TB.Cells(z, s).Text) & ";"
Next s
'Damit am Ende jeder Zeile, also nach der letzten Zelle kein Strichpunkt mehr gesetzt wird,
'muss das letzte Zeichen wieder abgezogen werden
TMP = Left(TMP, Len(TMP) - 1)
'Print fügt hier immer eine Zeile zur bestehenden Textdatei hinzu
Print #Dateinummer, TMP
'Die Variable TMP muss vor der Aufnahme der nächsten Zeile wieder geleert werden
TMP = ""
Next z
Close #Dateinummer
'Excel in Taskleiste legen
Application.WindowState = xlMinimized
'Workbook schließen
ActiveWorkbook.Close
Application.DisplayAlerts = True
vorigeZelle.Select
End Sub
Sub CSV()
Dim vorigeZelle As Range
Set vorigeZelle = ActiveCell
Application.ScreenUpdating = True
Application.DisplayAlerts = False
'Passwort abfragen
Passwort = InputBox("Passwort?")
If Passwort <> "Chef" Then Exit Sub
'Leerzeilen in der Holzliste löschen Bezugszelle ist Stückzahl (Spalte E)
Dim LgZ%, LZ As Double, X%
With Worksheets("Holzliste").Range("E5")
LgZ = Cells(Rows.Count, 5).End(xlUp).Row
For X = 5 To LgZ
On Error Resume Next
If Not IsEmpty(Cells(X, 5)) And Cells(X, 5) <> 0 Then
Else: Exit For
End If
Next X
LgZ = X
LZ = Rows.Count
End With
Rows((LgZ) & ":" & (LZ)).EntireRow.Delete Shift:=xlUp
Columns("BE:FG").Select
Selection.Delete Shift:=xlToLeft
'TabellenblätterLöschen()
Dim Arbeitsblatt As Worksheet
For Each Arbeitsblatt In Worksheets
If Arbeitsblatt.Name = "Holzliste" Then
Arbeitsblatt.Visible = xlSheetVisible
Else: Arbeitsblatt.Delete
End If
Next Arbeitsblatt
'SpeichernUnter()
Speicher = InputBox("Speicher Name : ")
Dim DName, Dateiname, Pfad
Pfad = "C:\v71\LISTEN"
DName = Speicher
Dateiname = Pfad & "\" & DName & ".csv"
ThisWorkbook.SaveAs Filename:=Dateiname, FileFormat:= _
xlCSV
'Excel in Taskleiste legen
Application.WindowState = xlMinimized
'Workbook schließen
ActiveWorkbook.Close
Application.DisplayAlerts = True
vorigeZelle.Select
End Sub