Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
19.04.2024 13:58:02
Set Worksheet geht im O365 aber im Excel 2016 nicht
19.04.2024 13:49:38
Per Kopfdruck als pdf speichern und Mail erstellen
19.04.2024 12:58:59
Daten einfügen aus anderem Sheet
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
816to820
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Text aus C2 als Überschrift bestimmen

Text aus C2 als Überschrift bestimmen
07.11.2006 20:01:03
Wolfgang
Hallo*
mit nachstehendem Code, der über Tabellenblattschaltfläche aktiviert wird, wird erreicht, dass über Einstellungen per Listenfeld Daten aus einer Textdatei in die jeweils zugewiesene Spalte eines wiederum jeweils zugewiesenen Arbeitsblattes (Listenfelder)eingefügt werden. Wie kann ich erreichen, dass die jeweils importierte Überschrift in Zeile 1 durch den vorhandenen Text (wechselt in Abhängigkeit des Listenfeldes)der Zelle C2, Tabellenblatt "Steuerung" bzw. Tabelle 21 ersetzt wird? - Bekomme das irgendwie mit dem Makrorekorder nicht hin und wäre für Rückmeldungen sehr dankbar.
Herzliche Grüße - Wolfgang

Private Sub CommandButton3_Click()
'Bildschirmflackern aus
Application.ScreenUpdating = False
Dim Ordner As String, Ziel As String, Tabelle As String
With Application
Ordner = .Range("Ordner") & "\" & .Range("Datei")
Ziel = .Range("Spalte") & "1"
Tabelle = .Range("Tabelle")
End With
Call Import1(Ordner, ActiveWorkbook.Worksheets(Tabelle), Ziel)
Tabelle21.Select
Range("A1").Select
'Bildschirmflackern aus
Application.ScreenUpdating = True
End Sub

Sub Import1(Datei As String, wks As Worksheet, Ziel As String)
wks.Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Datei, Destination:=Range(Ziel))
.Name = "KundeA"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
...weil der Makrorecorder immer vom aktuellen...
08.11.2006 02:55:45
Luc
...Inhalt von C2 ausgeht, Wolfgang.
Wie soll er auch erraten können, dass demnächst was Anderes in C2 stehen wird. Mit dem Recorder kann man wirklich nicht alle Probleme lösen. Ordentliche Programme mit Verarbeitungszyklen und allem drum und dran kann er niemals liefern!
Wenn du die Programmzeile .Name = "KundeA" meinst, muss sie variabel 

.Name = Worksheets("Steuerung").Range("C2")
oder 
.Name = ActiveWorkbook.Sheets(21).Range("C2").Value
oder in einer der möglichen Variationen davon lauten (.Value kann entfallen). Gruß Luc :-?
Anzeige
AW: ...weil der Makrorecorder immer vom aktuellen.
08.11.2006 06:17:45
Wolfgang
Hallo Luc,
danke für Deine Rückmeldung und Hinweise; Ich befürchte, die Frage wohl mißverständlich gestellt zu haben. Durch den Code Import1 habe ich vorbestimmt, dass aus der Textdatei lediglich eine Spalte importiert wird. Diese importierte Spalte enthält eine Überschrift, die ich mit dem jeweiligen Text aus C2 der Tabelle Steuerung ersetzen möchte. - Wenn ich das richtig beobachte, bewirkt der Name im Code Import1 nichts. Ich müßte, so könnte ich mir vorstellen, direkt im Code CommandButton 3 etwas einrichten, was die alte Überschrift in der jeweiligen Spalte und dann Zeile 1 löscht, um dann den Text aus C2 dort einzufügen. Hast Du da evtl. noch eine Idee? - Danke schon jetzt wieder für die Rückmeldung.
Herzliche Grüße
Wolfgang
Anzeige
AW: ...weil der Makrorecorder immer vom aktuellen.
08.11.2006 07:30:21
Erich
Hallo Wolfgang,
probier mal dioe drei Varianten (ungetestet): 
Option Explicit
Private Sub CommandButton3_Click()
'Bildschirmflackern aus
Application.ScreenUpdating = False
Call Import1([Ordner] & "\" & [Datei], Sheets([Tabelle]), [Spalte] & "1")
Range([Spalte] & "1") = Worksheets("Steuerung").Range("C2")
Sheets("Steuerung").Select
Range("A1").Select
'Bildschirmflackern aus
Application.ScreenUpdating = True
End Sub
Private Sub yCommandButton3_Click()
Dim Ordner As String, Ziel As String, Tabelle As String
'Bildschirmflackern aus
Application.ScreenUpdating = False
Ordner = [Ordner] & "\" & [Datei]
Ziel = [Spalte] & "1"
Tabelle = [Tabelle]
Call Import1(Ordner, ActiveWorkbook.Worksheets(Tabelle), Ziel)
Range([Spalte] & "1") = Worksheets("Steuerung").Range("C2")
Sheets("Steuerung").Select
Range("A1").Select
'Bildschirmflackern aus
Application.ScreenUpdating = True
End Sub
Private Sub xCommandButton3_Click()
Dim Ordner As String, Ziel As String, Tabelle As String
'Bildschirmflackern aus
Application.ScreenUpdating = False
With Application
Ordner = .Range("Ordner") & "\" & .Range("Datei")
Ziel = .Range("Spalte") & "1"
Tabelle = .Range("Tabelle")
Call Import1(Ordner, ActiveWorkbook.Worksheets(Tabelle), Ziel)
.Range("Spalte" & "1") = Worksheets("Steuerung").Range("C2")
End With
Sheets("Steuerung").Select
Range("A1").Select
'Bildschirmflackern aus
Application.ScreenUpdating = True
End Sub
Sub Import1(Datei As String, wks As Worksheet, Ziel As String)
wks.Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Datei, Destination:=Range(Ziel))
'.Name = "KundeA"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array( _
9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: funktionieren leider nicht
08.11.2006 18:50:31
Wolfgang
Hallo Erich,
erneut herzlichen Dank für Deine Rückmeldung und Deine Ausarbeitungen; ich habe sie erst jetzt testen können, leider aber ohne Erfolg. Es erscheinen unterschiedliche Fehlermeldungen:
zu 1) Laufzeitfehler 13, Typen unverträglich (Call Import... wird gelb markiert)
zu 2) Laufzeitfehler 9, Index liegt außerhalb des gültigen Bereichs
zu 3) Die Methode Range für das Objekt Application' i.....(weiter geht's dann nicht).
In der zweiten Ausarbeitung von Dir habe ich dabei festgestellt, dass der Text, den ich jeweils als Überschrift in Zeile 1 der jeweiligen Spalte haben möchte, dort angezeigt wird.
Vielleicht muß ja somit gar nicht der Umweg über "Steuerung" gegangen werden. Der Text ist nämlich der Dateiname der jeweils angesprochenen Textdatei (Ordner\Datei). Wäre darin vielleicht eher ein Lösungsansatz? - Danke schon jetzt wieder für Deine Rückmeldung
Herzliche Grüße
Wolfgang
Anzeige
AW: funktionieren leider nicht
08.11.2006 19:36:01
Erich
Hallo Wolfgang,
"ungetestet" war nicht unwichtig - da waren noch einige Ungereimtheiten drin. Sorry!
So sollte es laufen: 
Option Explicit
Private Sub CommandButton3_Click()
Dim strOrdn As String, strZiel As String, strTabe As String
Application.ScreenUpdating = False                 'Bildschirmflackern aus
strOrdn = [Ordner]
If Right(strOrdn, 1) <> "\" Then strOrdn = strOrdn & "\"
strOrdn = strOrdn & [Datei]
strZiel = [Spalte] & "1"
strTabe = [Tabelle]
Call Import1(strOrdn, ActiveWorkbook.Worksheets(strTabe), strZiel)
Range([Spalte] & "1") = Worksheets("Steuerung").Range("C2")
Sheets("Steuerung").Select
Range("A1").Select
Application.ScreenUpdating = True                  'Bildschirmflackern aus
End Sub
Sub Import1(Datei As String, wks As Worksheet, Ziel As String)
wks.Select
With wks.QueryTables.Add(Connection:="TEXT;" & Datei, Destination:=wks.Range(Ziel))
'.Name = "KundeA"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array( _
9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, _
9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Hier eine Beispielmappe:
https://www.herber.de/bbs/user/37995.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: funktionieren leider nicht
08.11.2006 21:09:32
Wolfgang
Hallo Erich,
erneut wieder herzlichen Dank für Deine Rückmeldung; irgendetwas mache ich momentan noch falsch; Ich habe versucht, auch die Beispielsmappe anzupassen; der Import funktioniert auch soweit, die Überschrift bleibt aber die alte. Ich werde nun, da ich ja daraus lernen möchte, nun einfach mit Deinen Hinweisen erst einmal weiter testen und mich dann beizeiten noch wieder melden. In dem Sinne nochmals zunächst herzlichen Dank.
Gruß - Wolfgang
AW: funktionieren leider nicht
08.11.2006 21:21:22
Erich
Hallo Wolfgang,
jetzt hab ichs (hoffentlich) gesehen:
Ersetz mal
Range([Spalte] & "1") = Worksheets("Steuerung").Range("C2")
durch
ActiveWorkbook.Worksheets(strTabe).Range(strZiel) = Worksheets("Steuerung").Range("C2")
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
Danke Erich, funktioniert
08.11.2006 21:48:43
Wolfgang
Hallo Erich,
schön, dass Du Dich noch wieder erneut gemeldet hast. Ich habe den Code in der Beispielsmappe entsprechend umgearbeitet und er funktioniert nun wunderbar. Ich bin zuversichtlich, den Code somit auch für meine Mappe anpassen zu können. Herzlichen Dank erneut und weiterhin alles Gute.
Gruß - Wolfgang

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige