25.11.2014, 14:00
Hallo,
ich habe leider recht wenig (also gar keine) Ahnung von VBA, bräuchte aber dringend für die Arbeit ein Makro und habe leider nicht genug Zeit mich einzuarbeiten.
Die Problemstellung ist folgende:
Eine Koordinatenmessmaschine gibt die Messwerte einer Serienmessung von 10 Teilen in eine Sammeldatei aus. Dies ist eine mit Tab getrennte .txt und wird mit folgendem Code ausgelesen
Nach dem Einlesen sollen bestimmte Felder/Bereiche kopiert und in vorgefertigte Excel Protokolle eingefügt werden. Es handelt sich um ca. 100 verschiedene Protokolle, die zwar vom Layout her gleich sind, sich in Dateiname und Spaltenanzahl aber unterscheiden. Die unterschiedliche Spaltenanzahl ist dann ja aber nur eine Anpassungssache.
Jemand hat mir diesen Code zum kopieren und einfügen gegeben, allerdings habe ich damit noch ein paar Probleme:
Das Hauptproblem ist, dass die Werte nicht einfach als Text kopiert werden sondern anscheinend als "Objekt" (sieht dann aus wie ein Bild oder ne Textbox oder sowas).
Eigentlich sollte die Quelldatei geschlossen werden und die Zieldatei sollte geöffnet und aktiviert werden. Wenn ich jedoch objWBTarget.Activate benutze läuft irgendwas im Hintergrund ab, ein Prozess "Excel" im Taskmanager entsteht und die Datei wird gesperrt, bis ich den Prozess kille.
Also nochmal zusammengefasst sollen die Werte kopiert werden, dann die Quelldatei geschlossen werden und die Zieldatei geöffnet werden.
Mfg
ich habe leider recht wenig (also gar keine) Ahnung von VBA, bräuchte aber dringend für die Arbeit ein Makro und habe leider nicht genug Zeit mich einzuarbeiten.
Die Problemstellung ist folgende:
Eine Koordinatenmessmaschine gibt die Messwerte einer Serienmessung von 10 Teilen in eine Sammeldatei aus. Dies ist eine mit Tab getrennte .txt und wird mit folgendem Code ausgelesen
Code:
Sub merge_öffnen()
'
' Sammeldatei merge__chr.txt öffnen
'
Workbooks.OpenText Filename:= _
"S:\xxx\xxx\merge__chr.txt", _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1)), _
DecimalSeparator:=".", ThousandsSeparator:=",", TrailingMinusNumbers:= _
True
End SubNach dem Einlesen sollen bestimmte Felder/Bereiche kopiert und in vorgefertigte Excel Protokolle eingefügt werden. Es handelt sich um ca. 100 verschiedene Protokolle, die zwar vom Layout her gleich sind, sich in Dateiname und Spaltenanzahl aber unterscheiden. Die unterschiedliche Spaltenanzahl ist dann ja aber nur eine Anpassungssache.
Jemand hat mir diesen Code zum kopieren und einfügen gegeben, allerdings habe ich damit noch ein paar Probleme:
Code:
Public Function copyData1()
Dim fd As FileDialog
Dim file As String
Dim objApp, objWBSource, objWBTarget, objWSSource, objWSTarget As Object
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
'Mehrfachauswahl verbieten
.AllowMultiSelect = False
.Title = "Zieldatei wählen..."
'Filter löschen
.Filters.Clear
'Neue Filter hinzufügen
.Filters.Add "Exceldateien", "*.xlsx; *.xlsm", 1
'Prüfen ob Abgebrochen wurde
If .Show = -1 Then
file = .SelectedItems(1)
Else
Exit Function
End If
End With
'Datei öffnen
Set objApp = CreateObject("Excel.Application")
Set objWBTarget = objApp.Workbooks.Open(file)
Set objWBSource = ActiveWorkbook
'Zieltabelle auswählen
Set objWSTarget = objWBTarget.Worksheets("Prüfprotokoll")
'Quelltabelle wählen 1.Zeile für eigenen Namen - 2. Zeile für aktive Tabelle
'Set objWSSource = objWBSource.Worksheets("")
Set objWSSource = ActiveSheet
'Zellen Kopieren - Entweder einen ganzen Bereich z.B. Range("A1:A5") oder eine einzelne Zelle
'z.B. Range("A1") oder eben über den Namen einer Zelle oder Zellbereichs Range("CELLNAME")
'ggf. hier eine Schleife beginnen oder die nächsten Zeilen für jeden Datensatz einzeln
'aufrufen
'BEGIN COPY-PASTE-BLOCK
'Quellworkbook aktivieren
objWSSource.Activate
Application.CutCopyMode = False
objWSSource.Range("F2").Copy
'und Einfügen an die passende Stelle
objWSTarget.Range("B28").PasteSpecial
'END COPY-PASTE-BLOCK
'Ziel speichern und schließen
objWBTarget.Save
objWBTarget.Close
'Zurück zu Quelldatei wechseln
objWBSource.Activate
'Speicher freigeben
objApp.Quit
Set objWSTarget = Nothing
Set objWSSource = Nothing
Set objWBTarget = Nothing
Set objWBSource = Nothing
Set objApp = Nothing
Set fd = Nothing
End FunctionDas Hauptproblem ist, dass die Werte nicht einfach als Text kopiert werden sondern anscheinend als "Objekt" (sieht dann aus wie ein Bild oder ne Textbox oder sowas).
Eigentlich sollte die Quelldatei geschlossen werden und die Zieldatei sollte geöffnet und aktiviert werden. Wenn ich jedoch objWBTarget.Activate benutze läuft irgendwas im Hintergrund ab, ein Prozess "Excel" im Taskmanager entsteht und die Datei wird gesperrt, bis ich den Prozess kille.
Also nochmal zusammengefasst sollen die Werte kopiert werden, dann die Quelldatei geschlossen werden und die Zieldatei geöffnet werden.
Mfg