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