Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
196to200
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
196to200
196to200
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Zeilenumbrung und Textspalten einfügen

Zeilenumbrung und Textspalten einfügen
03.01.2003 11:01:24
iris
hallo in die runde
ich habe eine excel-vorlage mit zeilenumbruch (Zellen, Ausrichtung, Zeilenumbruch) erstellt, weil die spalten immer die gleiche breite haben müssen. Wenn ich nun aus einer txt-datei daten einfüge, muss ich jedes mal wieder den zeilenumbruch neu definieren. gibt's dafür eine lösung?
freue mich auf eine antwort ;-) !

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Zeilenumbrung und Textspalten einfügen
03.01.2003 11:56:05
Nepumuk
Hallo Iris,
wie werden die Daten eingefügt? (per Makro / per Importfunktion von Excel / per kopieren & einfügen)
Gruß
Nepumuk
Re: Zeilenumbrung und Textspalten einfügen
03.01.2003 12:12:34
iris
hallo nepumuk
ich öffene die textdatei (3 spalten mit semikolon als trennzeichen) in excel und konvertiere sie entsprechend.


Re: Zeilenumbrung und Textspalten einfügen
03.01.2003 12:39:36
Nepumuk
Hallo Iris,
da hilft nur ein VBA-Programm. Wenn du willst, schreib ich es dir. Brauche aber noch ein paar Informationen.
1. Name der Textdatei variabel?
2. Speicherort der Textdatei variabel?
3. Zeilen/Spalten in die der Text eingefügt wird variabel?
Gruß
Nepumuk
Re: Zeilenumbrung und Textspalten einfügen
03.01.2003 13:03:48
iris
Hallo Nepumuk
Wow, grandios!! Also:
Textdatei: variabel
Speicherort: variabel
Vorlagenname: CD_Einleger.xlt
Zeilen/Spalten: C4:C23 und/oder H4:H23 (je nach Datenmenge)
Spaltenbreite: je 38.57 (fix)
Herzlichen Dank für deine Bemühungen *freu* !


Anzeige
Re: Zeilenumbrung und Textspalten einfügen
03.01.2003 15:55:19
Nepumuk
Hallo Iris,
ich habe eine Mappe an deine Mail-Adresse geschickt. Damit aber alle was davon haben:

Option Explicit
Option Compare Text
Public sSave As String
Private Const VER_PLATFORM_WIN32_NT = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetFileNameFromBrowseW Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As Long, ByVal nMaxFile As Long, ByVal lpstrInitialDir As Long, ByVal lpstrDefExt As Long, ByVal lpstrFilter As Long, ByVal lpstrTitle As Long) As Long
Private Declare Function GetFileNameFromBrowseA Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As String, ByVal nMaxFile As Long, ByVal lpstrInitialDir As String, ByVal lpstrDefExt As String, ByVal lpstrFilter As String, ByVal lpstrTitle As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub GetFileName()
Dim hWnd As Long
sSave = Space(255)
hWnd = FindWindow(vbNullString, ThisWorkbook.Name)
If IsWinNT Then
GetFileNameFromBrowseW hWnd, StrPtr(sSave), 255, StrPtr("c:\"), StrPtr("txt"), StrPtr("Text files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All files (*.*)" + Chr$(0) + "*.*" + Chr$(0)), StrPtr("The Title")
Else
GetFileNameFromBrowseA hWnd, sSave, 255, "c:\", "txt", "Text files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All files (*.*)" + Chr$(0) + "*.*" + Chr$(0), "The Title"
End If
End Sub
Public Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
Public Sub Textimport()
Call GetFileName
If sSave <> "" Then UserForm1.Show
End Sub
Public Sub Importstart()
Dim Text As String, Hfile As Integer, Zeile As Integer, Spalte As Integer
Application.ScreenUpdating = False
Spalte = 3
Zeile = 4
Hfile = FreeFile()
Open sSave For Input As #Hfile
Do While Not EOF(1)
Input #Hfile, Text
Cells(Zeile, Spalte) = Mid(Text, 1, InStr(1, Text, ";") - 1)
Cells(Zeile, Spalte + 1) = Mid(Text, InStr(1, Text, ";") + 1, InStr(InStr(1, Text, ";"), Text, ";") - 1)
Cells(Zeile, Spalte + 2) = Mid(Text, InStr(InStr(1, Text, ";") + 1, Text, ";") + 1)
Zeile = Zeile + 1
If Zeile = 24 Then
Zeile = 4
Spalte = 8
End If
Loop
Close #Hfile
End Sub

In der Userform (ein großes Label für die Textvorschau und zwei Commandbuttons)

Option Explicit
Private Sub UserForm_Activate()
Dim Text As String, Hfile As Integer
Hfile = FreeFile()
Open sSave For Input As #Hfile
Do While Not EOF(1)
Input #Hfile, Text
Label1 = Label1 + Text & vbNewLine
Loop
Close #Hfile
End Sub
Private Sub CommandButton1_Click()
Unload UserForm1
End Sub
Private Sub CommandButton2_Click()
Unload UserForm1
Call Importstart
End Sub

Gruß
Nepumuk

Anzeige
Re: Zeilenumbrung und Textspalten einfügen
04.01.2003 12:27:35
iris
Hallo Nepumuk
Vorerst ganz herzlichen Dank für deine Bemühungen! 8-)
Ich habe wenig VBA-Kenntnisse, drum folgende Fragen:
Du hast 2 Makros erstellt, wobei zuerst "Textimport" und anschliessend "Importstart" ausgeführt wird?

Folgende Fehler sind beim Ausprobieren aufgetreten:

Option Explicit
Option Compare Text
Public sSave As String
Private Const VER_PLATFORM_WIN32_NT = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetFileNameFromBrowseW Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As Long, ByVal nMaxFile As Long, ByVal lpstrInitialDir As Long, ByVal lpstrDefExt As Long, ByVal lpstrFilter As Long, ByVal lpstrTitle As Long) As Long
Private Declare Function GetFileNameFromBrowseA Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As String, ByVal nMaxFile As Long, ByVal lpstrInitialDir As String, ByVal lpstrDefExt As String, ByVal lpstrFilter As String, ByVal lpstrTitle As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub GetFileName()
Dim hWnd As Long
sSave = Space(255)
hWnd = FindWindow(vbNullString, ThisWorkbook.Name)
If IsWinNT Then
GetFileNameFromBrowseW hWnd, StrPtr(sSave), 255, StrPtr("c:\"), StrPtr("txt"), StrPtr("Text files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All files (*.*)" + Chr$(0) + "*.*" + Chr$(0)), StrPtr("The Title")
Else
GetFileNameFromBrowseA hWnd, sSave, 255, "c:\", "txt", "Text files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All files (*.*)" + Chr$(0) + "*.*" + Chr$(0), "The Title"
End If
End Sub
Public Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
Public Sub Textimport()
Call GetFileName
If sSave <> "" Then UserForm1.Show
End Sub
Public Sub Importstart()
Dim Text As String, Hfile As Integer, Zeile As Integer, Spalte As Integer
Application.ScreenUpdating = False
Spalte = 3
Zeile = 4
Hfile = FreeFile()

'Folgende Zeile: Laufzeitfehler '75' / Fehler beim Zugriff auf PFad/Dateiname
Open sSave For Input As #Hfile
Do While Not EOF(1)
Input #Hfile, Text

'Folgende Zeile: Laufzeitfehler '5' / Ungültiger Prozeduraufruf oder ungültiges Argument
Cells(Zeile, Spalte) = Mid(Text, 1, InStr(1, Text, ";") - 1)
Cells(Zeile, Spalte + 1) = Mid(Text, InStr(1, Text, ";") + 1, InStr(InStr(1, Text, ";"), Text, ";") - 1)
Cells(Zeile, Spalte + 2) = Mid(Text, InStr(InStr(1, Text, ";") + 1, Text, ";") + 1)
Zeile = Zeile + 1
If Zeile = 24 Then
Zeile = 4
Spalte = 8
End If
Loop
Close #Hfile
End Sub

In der Userform (ein großes Label für die Textvorschau und zwei Commandbuttons)

Option Explicit
Private Sub UserForm_Activate()
Dim Text As String, Hfile As Integer
Hfile = FreeFile()
Open sSave For Input As #Hfile
Do While Not EOF(1)
Input #Hfile, Text
Label1 = Label1 + Text & vbNewLine
Loop
Close #Hfile
End Sub
Private Sub CommandButton1_Click()
Unload UserForm1
End Sub
Private Sub CommandButton2_Click()
Unload UserForm1
Call Importstart
End Sub


Anzeige
Re: Zeilenumbrung und Textspalten einfügen
04.01.2003 12:34:58
iris
Hallo Nepumuk
Vorerst ganz herzlichen Dank für deine Bemühungen! 8-)
Ich habe wenig VBA-Kenntnisse, drum folgende Fragen:
Du hast 2 Makros erstellt, wobei zuerst "Textimport" und anschliessend "Importstart" ausgeführt wird?

Folgende Fehler sind beim Ausprobieren aufgetreten:

Option Explicit
Option Compare Text
Public sSave As String
Private Const VER_PLATFORM_WIN32_NT = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetFileNameFromBrowseW Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As Long, ByVal nMaxFile As Long, ByVal lpstrInitialDir As Long, ByVal lpstrDefExt As Long, ByVal lpstrFilter As Long, ByVal lpstrTitle As Long) As Long
Private Declare Function GetFileNameFromBrowseA Lib "shell32" Alias "#63" (ByVal hwndOwner As Long, ByVal lpstrFile As String, ByVal nMaxFile As Long, ByVal lpstrInitialDir As String, ByVal lpstrDefExt As String, ByVal lpstrFilter As String, ByVal lpstrTitle As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Sub GetFileName()
Dim hWnd As Long
sSave = Space(255)
hWnd = FindWindow(vbNullString, ThisWorkbook.Name)
If IsWinNT Then
GetFileNameFromBrowseW hWnd, StrPtr(sSave), 255, StrPtr("c:\"), StrPtr("txt"), StrPtr("Text files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All files (*.*)" + Chr$(0) + "*.*" + Chr$(0)), StrPtr("The Title")
Else
GetFileNameFromBrowseA hWnd, sSave, 255, "c:\", "txt", "Text files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All files (*.*)" + Chr$(0) + "*.*" + Chr$(0), "The Title"
End If
End Sub
Public Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
Public Sub Textimport()
Call GetFileName
If sSave <> "" Then UserForm1.Show
End Sub
Public Sub Importstart()
Dim Text As String, Hfile As Integer, Zeile As Integer, Spalte As Integer
Application.ScreenUpdating = False
Spalte = 3
Zeile = 4
Hfile = FreeFile()

'Folgende Zeile: Laufzeitfehler '75' / Fehler beim Zugriff auf PFad/Dateiname
Open sSave For Input As #Hfile
Do While Not EOF(1)
Input #Hfile, Text

'Folgende Zeile: Laufzeitfehler '5' / Ungültiger Prozeduraufruf oder ungültiges Argument
Cells(Zeile, Spalte) = Mid(Text, 1, InStr(1, Text, ";") - 1)
Cells(Zeile, Spalte + 1) = Mid(Text, InStr(1, Text, ";") + 1, InStr(InStr(1, Text, ";"), Text, ";") - 1)
Cells(Zeile, Spalte + 2) = Mid(Text, InStr(InStr(1, Text, ";") + 1, Text, ";") + 1)
Zeile = Zeile + 1
If Zeile = 24 Then
Zeile = 4
Spalte = 8
End If
Loop
Close #Hfile
End Sub

In der Userform (ein großes Label für die Textvorschau und zwei Commandbuttons)

Option Explicit
Private Sub UserForm_Activate()
Dim Text As String, Hfile As Integer
Hfile = FreeFile()
Open sSave For Input As #Hfile
Do While Not EOF(1)
Input #Hfile, Text
Label1 = Label1 + Text & vbNewLine
Loop
Close #Hfile
End Sub
Private Sub CommandButton1_Click()
Unload UserForm1
End Sub
Private Sub CommandButton2_Click()
Unload UserForm1
Call Importstart
End Sub


Anzeige

322 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige