Warum habe ich gänsefüsse in meiner txt datei
21.02.2007 00:57:00
Swen
ich exportiere ein worksheet als txt datei
irgendwie habe ich aber wenn ich mir die txt datei dann
anschaue aber Gänsefüsse " for und hinter der spalte.
Wie kann ich dieses ändern?
Hier das Makro welches meine zu expotierende seite erstellt
Sub Cad_erstellen()
'***** Tabellenblatt erstellen
NeuesBlatt ("cad")
'***** Header Daten einfügen
With Worksheets("cad")
strText = "DEVICE NAME = #" & _
Worksheets("Coordinates").Cells(1, 7).Value
.Cells(1, 1).Value = strText
strText = "PAD NUMBER = #" & _
Worksheets("Coordinates").Cells(17, 3).Value / _
Worksheets("Coordinates").Cells(16, 3).Value
.Cells(2, 1).Value = strText
strText = "INDEX SIZE X (1/1000) = #" & _
Worksheets("Coordinates").Cells(19, 3).Value * 1000
.Cells(3, 1).Value = strText
strText = "INDEX SIZE Y (1/1000) = #" & _
Worksheets("Coordinates").Cells(19, 3).Value * 1000
.Cells(4, 1).Value = strText
intAnfang = Zelle_suchen_in_Spalte("Lfd.Nr.", 1, 1, 50, "Coordinates")
blnPADinCoor = False
intNadelProDie = (Worksheets("Coordinates").Cells(17, 3).Value / _
Worksheets("Coordinates").Cells(16, 3).Value)
For intZaehler = 1 To 50
If Worksheets("Coordinates").Cells(intAnfang, intZaehler) = "X-Pad" Then
blnPADinCoor = True
intXSpaltePad = intZaehler
intYSpaltePad = intZaehler + 1
Exit For
End If
Next intZaehler
dblNeedleRangeY = intNeedleRangeY(5, intAnfang + 1, intAnfang + intNadelProDie)
dblNeedleRangeX = intNeedleRangeX(4, intAnfang + 1, intAnfang + intNadelProDie)
dblNeedleRangeY = (dblNeedleRangeY / 2) * 1000
dblNeedleRangeX = (dblNeedleRangeX / 2) * 1000
For intZaehler = 1 To Worksheets("Coordinates").Cells(17, 3).Value / _
Worksheets("Coordinates").Cells(16, 3).Value
dblXWert = (Worksheets("Coordinates").Cells(intAnfang + intZaehler, 4).Value * 1000) - dblNeedleRangeX
dblYWert = (Worksheets("Coordinates").Cells(intAnfang + intZaehler, 5).Value * 1000) - dblNeedleRangeY
If blnPADinCoor = True Then
dblYWertPad = Worksheets("Coordinates").Cells(intAnfang + intZaehler, intYSpaltePad).Value * 1000
dblXWertPad = Worksheets("Coordinates").Cells(intAnfang + intZaehler, intXSpaltePad).Value * 1000
strText = intZaehler & Chr(9) & Chr(9) & dblXWert & "," & dblYWert & "," _
& dblXWertPad & "," & dblYWertPad
.Cells(intZaehler + 4, 1).Value = strText
Else
strPad = Worksheets("Coordinates").Cells(15, 7).Value
intErsteZahlEnde = InStr(strPad, " x")
intAnzahlDerBuchstaben = Len(strPad)
dblYWertPad = Mid(strPad, 1, intErsteZahlEnde - 1)
dblXWertPad = Mid(strPad, intErsteZahlEnde + 2, (intAnzahlDerBuchstaben - intErsteZahlEnde + 2))
dblYWertPad = dblYWertPad * 1000
dblXWertPad = dblXWertPad * 1000
strText = intZaehler & Chr(9) & Chr(9) & dblXWert & "," & dblYWert & "," _
& dblXWertPad & "," & dblYWertPad
.Cells(intZaehler + 4, 1).Value = strText
End If
Next intZaehler
End With
Call TabellezuCad
End Sub
Hier die Funktion die ich mir gebaut habe die mir die erstellte datei dann als txt datei
exportieren soll!
Function TabellezuCad()
'am 20.02.2007 überarbeitet
Dim smsg As String, spath As String
If Worksheet_suchen("cad") = True Then
Worksheets("cad").Select
smsg = "Wo soll die Datei abgelegt werden ?"
spath = ordner(smsg)
If spath <> "" Then strTempFolder = spath
strName = Worksheets("Coordinates").Cells(1, 7).Value
If Worksheet_suchen("cad") = True Then
'** Es wird eine Tabelle in eine cad/txt Datei gespeichert
strWorkbookName = ThisWorkbook.Name
'*** workbook einfügen ***'
Workbooks.Add
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strTempFolder & strName & ".cad", FileFormat:=xlText, CreateBackup:=False
Application.DisplayAlerts = False
'*** Zellen kopieren ***'
Workbooks(strWorkbookName).Activate
Worksheets("cad").Select
Cells.Select
Selection.Copy
'*** Zellen einfügen ***'
Workbooks(strName & ".cad").Activate
Cells.Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
'*** Datei Speichern als cad/txt File ***'
ActiveWorkbook.Save
ActiveWindow.Close
'*** Zurück auf das Projekt ***'
Windows(strWorkbookName).Activate
Cells(1, 1).Select
End If
End If
End Function
PS: Ich habe noch einige selektierungen und das objekt selection drin welche ich etwas umbauen kann
von der funktion sieht es schon gut aus den code möchte zu einem späteren zeitpunkt noch optimieren
gruß
swen