AW: .txt umbenennen
04.02.2008 15:24:10
Andi
Hallo Ramses,
Dein Code ist sicher etwas besser, jedoch stoppt das Programm beim
Workbooks.OpenText Filename:= _
"C:\Messung\Tabelle1.txt"
da er keine txt mit Namen Tabelle1 findet. Die Textdatei hat immer noch den gleichen Namen, obwohl das Programm ohne Fehler drüber geht.
Das folgende Programm zeigt nur den Anfang des Codes. Ich möchte eigentlich nur, dass das Sheet beim Öffnen der Textdatei nicht den gleichen Namen (Test-" & TextBox5 & "" & TextBox3 & ") zugewiesen bekommt, sondern einfach nur als Tabelle1 bezeichnet ist. Die Maximale Zeichenanzahl auf einem Tabellenblatt beträgt ja 31 Zeichen und ich komme darüber. Un das macht den Zugriff mit "Cells.Find(What:="Hauptfokusreihe:", ........" etwas schwierig. Von daher die Frage zur Änderung der txt-Namen.
Private Sub CommandButton1_Click()
Dim I%, n%
Dim t0 As Single, t1 As Single
If TextBox3.Value = "" Or _
TextBox4.Value = "" Or _
TextBox14.Value = "" Or _
TextBox6.Value = "" Or _
TextBox7.Value = "" Or _
TextBox8.Value = "" Then
MsgBox "Bitte alle Felder ausfüllen!"
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Name "C:\Messung\Test-" & TextBox5 & "" & TextBox3 & ".txt" As "Tabelle1.txt"
Workbooks.OpenText Filename:= _
"C:\Messung\Tabelle1.txt" _
, Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
Sheets("Tabelle1").Activate
Sheets("Tabelle1").Cells.Find(What:="Hauptfokusreihe:", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Sheets("Tabelle1").Cells.FindNext(After:=ActiveCell).Activate
n = ActiveCell.Row
Range("A" & n & ":Q" & n + 24 & "").Select
n = 0
Selection.Copy
Windows("Test.xls").Activate
Sheets("Achse").Activate
Range("A25").Select
ActiveSheet.Paste
'das Programm geht jetzt noch weiter
End Sub