Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1516to1520
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

TXT Export

TXT Export
06.10.2016 07:56:58
Roland
Hallo!
Vielleicht kann mir Jemand Helfen.
Habe foglenden Code mit Forumshilfe gebastelt, und wenn ich diesen ausführe wird nur die erste Zeile von Tabelle "ACAD" in eine Textdatei exportiert, ich brauche aber Zeile 1 und 2
Sub TXTspeichern()
'___Das aktuelle Blatt als TXT Datei abspeichern
'___Modifizierter Code von Herber - 19198
Dim Bereich As Range
Dim iRow As Integer, iCol As Integer
Dim Zeilen As Long, Spalten As Integer
Dim sTxt As String
Dim Verzeichnis As String
Dim Datei As String
Worksheets("ACAD").Activate
Range("ACADSCHRIFTKOPF").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Verzeichnis = ActiveWorkbook.Path & "\"
Datei = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "ACAD-Schriftkopf.txt"
'___Zieldatei befüllen
Close
Open Verzeichnis & Datei For Output As #1
On Error GoTo 0
Set Bereich = Range("ACADSCHRIFTKOPF").CurrentRegion
Spalten = Intersect(Bereich.SpecialCells(xlVisible), Bereich.Rows(1)).Count
Zeilen = Intersect(Bereich.SpecialCells(xlVisible), Bereich.Columns(1)).Count
For iRow = 1 To Zeilen
For iCol = 1 To Spalten
sTxt = sTxt & Cells(iRow, iCol).Text & vbTab
Next iCol
'___letztes Trennzeichen entfernen
sTxt = Left(sTxt, Len(sTxt) - 1)
Print #1, sTxt
sTxt = ""
Next iRow
'MsgBox "Die Datei " & Datei & " wurde im gleichen Verzeichnis erstellt!"
Worksheets("Checkliste Technik").Activate
End Sub Wenn ich den Code beim Schließen ausführe:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Call Modul2.TXTspeichern
End Sub
dann funktionierts, muss aber den code in ein anderes Makro einbauen damit dieser auf Knopfdruck richtig funktioniert.
Kann mir da irgend jemand helfen?
Bin für jeden Rat dankbar!

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: TXT Export
06.10.2016 09:29:28
UweD
Hallo
- es muss ja dann an der Variablen "Zeilen" liegen.
- Die kann ja dann max 1 sein.
- Lass die mal anzeigen.
- oder lade eine Musterdatei hoch
Tipp:
Select und activate kann in 99 % der Fälle entfallen.
Sub TXTspeichern()
'___Das aktuelle Blatt als TXT Datei abspeichern 
'___Modifizierter Code von Herber - 19198 

    Dim Bereich As Range
    Dim iRow As Integer, iCol As Integer
    Dim Zeilen As Long, Spalten As Integer
    Dim sTxt As String
    Dim Verzeichnis As String
    Dim Datei As String
    
    With Worksheets("ACAD").Range("ACADSCHRIFTKOPF")
        .Value = .Value
    
        Verzeichnis = ActiveWorkbook.Path & "\"
        Datei = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "ACAD-Schriftkopf.txt"
        '___Zieldatei befüllen 
        
        Close #1
        Open Verzeichnis & Datei For Output As #1
        On Error GoTo 0
        Set Bereich = .CurrentRegion
        Spalten = Intersect(Bereich.SpecialCells(xlVisible), Bereich.Rows(1)).Count
        Zeilen = Intersect(Bereich.SpecialCells(xlVisible), Bereich.Columns(1)).Count
        MsgBox Zeilen ' zum Testen 
        For iRow = 1 To Zeilen
            For iCol = 1 To Spalten
                sTxt = sTxt & Cells(iRow, iCol).Text & vbTab
            Next iCol
            '___letztes Trennzeichen entfernen 
            sTxt = Left(sTxt, Len(sTxt) - 1)
            Print #1, sTxt
            sTxt = ""
        Next iRow
        Close #1
        'MsgBox "Die Datei " & Datei & " wurde im gleichen Verzeichnis erstellt!" 
    
    End With
    'Worksheets("Checkliste Technik").Activate 

End Sub

LG UweD
Anzeige
AW: TXT Export
06.10.2016 16:44:50
Roland
Danke Fehler gefunden!
Close war in der falschen Zeile.
Habe "Close" runter geschoben nach "Next iRow" und jetzt gehts!
Danke!
Prima! Danke für die Rückmeldung.
07.10.2016 08:16:16
UweD

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige