Office: .txt Datei per Button importieren

tosymb · 12. Februar 2015

Guten Tag,

ich habe wieder eine Frage bezüglich eines VBA Codes, um eine .txt Datei zu importieren.

Ich stelle mir den Ablauf so vor:

1) Auf den Button klicken
2) Datei-Auswahlfenster sollte sich öffnen (also das, was sich auch öffnet, wenn man oben aus dem Reiter die Importfunktion verwendet)
3) Dort soll man nun die .txt-Datei auswählen
4) Jetzt soll die Datei mit den Eigenschaften

- "Getrennt"

- Import beginnen in Zeile: "1"

- Dateiursprung: "Windows (ANSI)"

- Trennzeichen: "Tabstopp"

- Datenformat der Spalten: "Standard"

- Dezimaltrennzeichen: "."

- 1000er-Trennzeichen: ","

in die Tabelle2 ab A1 importiert werden.

Ich denke die Importeigenschaften wie "Getrennt", etc. würde ich schon selbst irgendwie hinbekommen, nur fehlt mir das hauptsächliche und wichtigere Grundgerüst.

Vielen Dank und viele Grüße
tosymb

:)

lupo1 · 14. Februar 2015

Solche selteneren Sachen lernt man mittels Makrorekorder.

xlph · 14. Februar 2015

naja, der Makrorekorder hilft da einem nicht viel weiter.

Code:

Public Sub TxtImport()
Dim varPath As Variant

varPath = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If varPath = False Then Exit Sub

Call Workbooks.OpenText(Filename:=varPath, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
Tab:=True, _
DecimalSeparator:=".", _
ThousandsSeparator:=",")

With ActiveWorkbook
.Worksheets(1).UsedRange.Copy Destination:=Tabelle2.Cells(1)
.Close SaveChanges:=False
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

tosymb · 14. Februar 2015

Hallo xlph,

danke dir erneut!

Ich bekomme leider wieder den Fehler wie aus dem anderen Thread, dassdie Variable "Tabelle2" nicht definiert sei. Woher kommt das? Im anderen Code haben wir das ja dann gegen "ActiveWorksheet" ersetzt, aber das wird hier ja nicht klappen, da das aktive Tabellenblatt dann ja das mit den Daten ist (wenn ich es richtig verstanden habe).

Habe zum Testen mal Tabelle2 durch Sheets("Messdaten") ersetzt (das Makro soll quasi als Vorstufe von dem, was du mir im anderen Thread geschrieben hast, dienen), da bekomme ich dann jedoch einen Fehler, dass der Index außerhalb des Bereiches läge.

Viele Grüße
tosymb

xlph · 15. Februar 2015

Dann mach es doch so:

Code:

Option Explicit

Public Sub TxtImport_Starten() ' Diese Prozedur starten

Dim varPath As Variant
Dim wksTargetWorksheet As Worksheet

varPath = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If varPath = False Then Exit Sub

Set wksTargetWorksheet = ThisWorkbook.Worksheets("Tabelle2") ' Blattname ggf. anpassen ***** (für das aktive Blatt = Activesheet)

Call TxtImport(wksTargetWorksheet)
Call ImportAufbereiten(wksTargetWorksheet)

Set wksTargetWorksheet = Nothing

End Sub

Private Sub TxtImport(strPath As String, wksTargetWorksheet As Worksheet)

Application.ScreenUpdating = False

wksTargetWorksheet.UsedRange.Clear

Call Workbooks.OpenText(Filename:=strPath, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
Tab:=True, _
DecimalSeparator:=".", _
ThousandsSeparator:=",")

With ActiveWorkbook
.Worksheets(1).UsedRange.Copy Destination:=wksTargetWorksheet.Cells(1)
.Close SaveChanges:=False
End With

Application.ScreenUpdating = True

End Sub

Private Sub ImportAufbereiten(wksTargetWorksheet As Worksheet)

Dim rngSpecialCells As Range

Const conAufbereitetCheck As String = _
"Sample #,Spannung,Gas,Sample Length,Averaging Interval (secs),,Filter?,Messung verwenden?,,Mean,Min,Max,Std. Dev."

On Error GoTo Fehlerbehandlung

With wksTargetWorksheet

If Join(WorksheetFunction.Transpose(.Range("A1:A13")), ",") = conAufbereitetCheck Then
MsgBox "Das Blatt wurde bereits aufbereitet!"
Exit Sub
End If

Application.ScreenUpdating = False

With .Columns(1)
If Not .Find("Comment for Sample") Is Nothing Then
Range(.Find("Comment for Sample"), .Cells(1).Offset(2 ^ 20 - 1)).EntireRow.Delete
End If
End With

.Rows("1:3").Delete

.Rows("2:3").Clear
.Range("A2").Value = "Spannung"
.Range("A3").Value = "Gas"

.Rows("6:9").Clear
.Range("A7").Value = "Filter?"
.Range("A8").Value = "Messung verwenden?"

With .UsedRange.Rows(1)

Set rngSpecialCells = getSpecialCells(.Cells, xlCellTypeBlanks)

If Not rngSpecialCells Is Nothing Then
rngSpecialCells.FormulaR1C1 = "=IF(ISNUMBER(RC[-1]),TRUE,1/0)"
End If

Set rngSpecialCells = getSpecialCells(.Cells, xlCellTypeFormulas, xlErrors)

If Not rngSpecialCells Is Nothing Then
Intersect(.Resize(14), rngSpecialCells.EntireColumn).Delete
End If

Set rngSpecialCells = getSpecialCells(.Cells, xlCellTypeFormulas, xlLogical)

If Not rngSpecialCells Is Nothing Then
rngSpecialCells.FormulaR1C1 = "=RC[-1]"
End If

.Value = .Value

Union(.Cells, .Offset(, 1)).EntireColumn.ColumnWidth = 17.5
.Cells(1, 1).EntireColumn.ColumnWidth = 19.5

End With

Intersect(.Rows(15), .UsedRange.Offset(, 1)).Replace "Elapsed (s)", "=1/0"

Set rngSpecialCells = getSpecialCells(.Rows(15), xlCellTypeFormulas, xlErrors)

If Not rngSpecialCells Is Nothing Then
Intersect(.UsedRange.Offset(15), rngSpecialCells.EntireColumn).Clear
End If

Set rngSpecialCells = getSpecialCells(.Rows(15), xlCellTypeFormulas, xlErrors)

If Not rngSpecialCells Is Nothing Then
rngSpecialCells.Value = "Number (#)"
End If

Intersect(.Rows(15), .UsedRange.Offset(, 1)).Replace "Elapsed (s)", "Number (#)"

With .UsedRange.Columns(.UsedRange.Columns.Count).Offset(, 1)
.Cells(1).Value = .Cells(1).Offset(, -1).Value
.Cells(15).Value = .Cells(15).Offset(, -2).Value
End With

Intersect(.Rows(15), .UsedRange).Font.Bold = True

.Range("A1:A14").HorizontalAlignment = xlRight
.Range("A1:A14").Font.Bold = True

.Cells.Font.Size = 11

End With

Fehlerbehandlung:

If Err.Number > 0 Then
MsgBox Err.Description, "Fehler: " & Err.Number
End If

Application.ScreenUpdating = True

Set rngSpecialCells = Nothing

End Sub

Private Function getSpecialCells(Bereich As Range, ZellTyp As XlCellType, Optional SpezialWert As XlSpecialCellsValue) As Range
On Error Resume Next
If SpezialWert > 0 Then
Set getSpecialCells = Bereich.SpecialCells(ZellTyp, SpezialWert)
Else
Set getSpecialCells = Bereich.SpecialCells(ZellTyp)
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

tosymb · 15. Februar 2015

Danke, leider bekomme ich immer den Fehler

"Argumenttyp ByRef unverträglich"

und es wird

wksTargetWorksheet

in der Zeile

"Call TxtImport(wksTargetWorksheet)"

markiert.

Habe es auch schon mit einem anderen Tabellennamen und mit Activesheet getestet, jedoch auch damit keinen Erfolg erzielen können.

Steffl72 · 15. Februar 2015

Hallo,

das Makro TxtImport benötigt 2 Parameter. Versuche es mal so

Code:

Call TxtImport(varPath, wksTargetWorksheet)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

xlph · 15. Februar 2015

Oh ja, da habe ich die Pfad-Variable vergessen.

tosymb · 15. Februar 2015

Hallo,

danke euch beiden, leider erhalte ich den Fehler trotzdem. Jetzt wird das eingefügte "varPath" markiert und die selbe Fehlermeldung erscheint.
Liegt es vielleicht daran, dass varPath einmal als Variant deklariert ist und im TxtImport-Sub dann strPath als String? Aber das ist nur wilde Vermutung...

Viele Grüße
tosymb

EarlFred · 15. Februar 2015

Hallo tosymb,

Aber das ist nur wilde Vermutung...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

warum das denn? Klicke die Fehlermeldung doch nicht einfach weg, sondern benutze mal den Button "Hilfe" - dann kannst Du den Grund im ersten Absatz lesen.

Grüße
EarlFred

Office: .txt Datei per Button importieren

.txt Datei per Button importieren

.txt Datei per Button importieren

.txt Datei per Button importieren

.txt Datei per Button importieren

.txt Datei per Button importieren - Similar Threads - Datei Button importieren

Datei speichern unter, Button abbrechen Makro beenden

Word Datei per Button drucken

Excel Button zum erstellen neuer Datei

Rechnungskopie ohne Makros und Buttons in eine andere Datei

mit button bestimmte excel datei schließen

Button der eine gewünschte Word Datei öffnet

Word 2002 XP unter Datei Button "Drucken..." 2 x