Spalten exportieren als ASCII *.txt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub save_as_text() Range("B4:C28").Copy Set NewSheet = Sheets.Add(Type:=xlWorksheet) NewSheet.Paste Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:= _ "C:\Dokumente und Einstellungen\volker\Eigene Dateien\Mappe2.txt", FileFormat _ :=xlText, CreateBackup:=False NewSheet.Delete Application.DisplayAlerts = True End Sub

Sub aufbereiten() Dim Dateiname As String, DateiNr As Integer Dat = InputBox("Bitte Dateinamen angeben (ohne Extension)") If Dat = "" Or Len(Dat) > 8 Then MsgBox ("es wird keine Datei angelegt!"), vbOKOnly: Exit Sub Dateiname = Dat & ".pol" anzahl = Sheets("Geograflin").Range("j1").Value DateiNr = FreeFile Open Dateiname For Output As DateiNr For i = 1 To anzahl wert1 = Cells(i, 2).Value l = Len(wert1) Do While l < 13 wert1 = wert1 & " " l = Len(wert1) Loop wert2 = Cells(i, 3).Value l = Len(wert2) If wert2 = "R" Then wert2 = Cells(i, 5).Value l = Len(wert2) Do While l < 13 wert2 = wert2 & " " l = Len(wert2) Loop Else Do While l < 13 wert2 = wert2 & " " l = Len(wert2) Loop End If code = Cells(i, 6).Value Print #DateiNr, wert1 & code & " 1 0" & Chr(10) & wert2 & code & " 1 0" & Chr(10) Next i Close DateiNr End Sub

Sub save_as_text() Do fname = Application.GetSaveAsFilename Loop Until fname <> False Range("B4:C28").Copy Set NewSheet = Sheets.Add(Type:=xlWorksheet) NewSheet.Paste Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:= _ fname, FileFormat _ :=xlText, CreateBackup:=False NewSheet.Delete Application.DisplayAlerts = True End Sub

Sub save_as_text() fname = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt), *.txt") If fname = False Then Exit Sub Range("B4:C28").Copy Set NewSheet = Sheets.Add(Type:=xlWorksheet) NewSheet.Paste Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:= _ fname, FileFormat _ :=xlText, CreateBackup:=False NewSheet.Delete Application.DisplayAlerts = True End Sub

Sub save_as_text() fname = InputBox("Dateinamen ohne .TXT eingeben") If fname = "" Then Exit Sub Range("B4:C28").Copy Set NewSheet = Sheets.Add(Type:=xlWorksheet) NewSheet.Paste Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:= _ fname, FileFormat _ :=xlText, CreateBackup:=False NewSheet.Delete Application.DisplayAlerts = True End Sub

Sub save_as_text() fname = InputBox("Dateinamen ohne .TXT eingeben") If fname = "" Then Exit Sub fname = fname & ".TXT" Range("B4:C28").Copy Set NewSheet = Sheets.Add(Type:=xlWorksheet) NewSheet.Paste Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:= _ fname, FileFormat _ :=xlText, CreateBackup:=False NewSheet.Delete Application.DisplayAlerts = True End Sub

Hallo
Markiere den Bereich den du exportieren willst, und löse das Makro aus
Option Explicit

Sub export_selected_Range_and_save_as_TXT()
    '(C) by Ramses
    'Exportiert einen ausgewählten Bereich in ein zu definierendes Textfile
    Dim i As Integer, n As Integer, maxExpCol As Integer, QE As Integer
    Dim StartRow As Integer, StartCol As Integer, selRow As Integer, selCol As Integer
    Dim myC As Range
    Dim expFolder As String, expFileName As String
    Dim myDiv As String, tmpExpText As String, expText As String
    'Maximal zu exportierende Spalten
    'Dieser Parameter ist anzupassen, um unterschiedliche Bereich
    'in ein einheitliches Exportformat zu bringen
    maxExpCol = 25
    'Default Pfad incl abschliessendem Backslash
    expFolder = "C:\Temp\"
    'Standard Name für TextExportFile
    expFileName = "Koordinaten.txt"
    '************************************************
    'Ab hier keine Änderungen mehr vornehmen
    'Trennzeichen für das Textfile
    myDiv = ";"
    If Selection.Columns.Count > maxExpCol Then
        MsgBox "Maximal zu exportierende Spaltenzahl überschritten"
        Exit Sub
    End If
    'Starbereich festlegen
    StartRow = Selection.Range("A1").Row
    StartCol = Selection.Range("A1").Column
    'Scheifenparameter initialisieren
    selRow = Selection.Rows.Count
    selCol = Selection.Columns.Count
    For i = StartRow To StartRow + selRow
        tmpExpText = ""
        For n = StartCol To StartCol + selCol
            tmpExpText = tmpExpText & Cells(i, n).Text & myDiv
        Next n
        'Exportfile auf erforderliche Länge bringen
        If Len(tmpExpText) < maxExpCol Then
            For n = Len(tmpExpText) To maxExpCol
                tmpExpText = tmpExpText & myDiv
            Next n
        End If
        expText = expText & tmpExpText & vbCrLf
    Next i
    'Exportfile und Speicherpfad kontrollieren
    expFileName = Application.GetSaveAsFilename(InitialFileName:=expFolder & expFileName, _
        fileFilter:="Text Files (*.txt), *.txt)", Title:="Exportpfad definieren")
    If Dir(expFileName) <> "" Then
        QE = MsgBox("Sollen die Daten an die existierende Datei angehängt werden," & vbCrLf & _
            "oder soll die Datei überschrieben werden ?" & vbCrLf & vbCrLf & _
            "JA = Anhängen" & vbCrLf & "NEIN = Datei überschreiben" & vbCrLf & "ABBRECHEN = Abbrechen", _
            vbYesNoCancel + vbCritical + vbDefaultButton1, "Exportverhalten definieren")
        If QE = vbCancel Then Exit Sub
        If QE = vbYes Then
            'Daten anhängen
            Open expFileName For Append As #1
            Print #1, expText
            Close #1
        Else
            'Daten überschreiben
            Open expFileName For Output As #1
            Print #1, expText
            Close #1
        End If
    Else
        'Daten erstmalig schreiben
        Open expFileName For Output As #1
        Print #1, expText
        Close #1
    End If
    MsgBox "Daten exportiert"
End Sub

Der Export ist in diesem Beispiel auf 25 Spalten begrenzt, aber das sollte reichen ;-)
Gruss Rainer

Hallo Volker,Cardexperte und Ramses!
Vielen Dank für die Hilfe, ich denke jetzt habe ich, was ich brauche. Die Version von Volker hat mir recht gut gefallen, weil sie einfach mit ein paar standardbefehlen funktionieren sollte, ich habe sie noch angepasst, aber leider habe ich es nicht geschafft, daß die originaldatei unangetastet bleibt.
@Cardexperte: Ich habe es einfach nicht geschafft, den code so zu modifizieren, daß es bei mir läuft (wie in dem ersten hochgeladenen Beispiel kommt die Fehlermeldung, daß der Indexbereich falsch definiert ist), aber danke dir trotzdem!
Und Ramses, danke Dir, das ist sehr gut, denn ich kann sogar den Exportbereich vorher auswählen und die Koordinaten dann darüberhinaus sogar an eine bestehende Datei anhängen. Mit dem 25 Spaltenlimit komme ich bestens aus, normalerweise brauche ich sowieso nur 2 für die x- und y- Koordinate. Jetzt muss ich nur noch ein Trennzeichen finden das mir der Theodolit erkennt und alles ist wunderbar! Danke vielmals!!!
Viktor

Beliebteste Forumthreads (12 Monate)

Spalten exportieren als ASCII *.txt

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalten exportieren als ASCII *.txt

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread