AW: VBA-Formatierung anpassen
27.11.2006 15:51:42
bully
Hollo Stefan,
danke für dein Vorschlag. Du hast recht meine Codezeile ist nur ein Teil des Codes. Dein Code läuft ohne Fehler durch, das Resultat des Exportes ist dann aber leider eine leere Datei. Deshalb hier der ganze Code:
Sub export7()
Dim strSep As String, strDat As String, _
iCol As Byte, iRow As Integer, _
iR As Integer, iC As Byte, strTxt As String, _
strMldg As String
iRow = ActiveSheet.UsedRange.Rows.Count
iCol = ActiveSheet.UsedRange.Columns.Count
strSep = 9
If strSep = "" Then Exit Sub
If strSep = "9" Then
strSep = Chr(9)
Else
strSep = Left(Trim(strSep), 1)
End If
DateiName:
strDat = InputBox("Dateiname?", "DateiName", ThisWorkbook.Path & "\SPRUNGM____1148___" & Format(Now, "YYYYMMDDHHMMSS") & ".txt")
If strDat = "" Then Exit Sub
If InStr(strDat, ":\") = 0 Then
strDat = ThisWorkbook.Path & "\" & strDat
End If
If Dir(strDat) <> "" Then
strMldg = MsgBox("Datei bereits vorhanden. Überschreiben?", vbYesNo)
If strMldg = vbNo Then GoTo DateiName
End If
On Error GoTo DateiFehler
Open strDat For Output As #1
For iR = 3 To iRow
strTxt = ""
For iC = 1 To iCol
If Columns(iC).Hidden = False Then
If iC <> 4 Then
strTxt = strTxt & Cells(iR, iC) & strSep
Else
strTxt = strTxt & Format(Cells(iR, 4), "ddmmyyyy") & strSep
End If
End If
Next iC
strTxt = Left(strTxt, Len(strTxt) - 1)
If Trim(Replace(strTxt, strSep, "")) > "" Then Print #1, strTxt
Next iR
Close #1
MsgBox ("Die Datei " & strDat & " wurde angelegt.")
Exit Sub
DateiFehler:
MsgBox ("Fehler in Dateinamen!")
Resume DateiName
End Sub
Der Code stammt aus diversen Forenbeiträgen, und wurde von mir zusammen geschustert. Vielleicht gibt es noch Optimierungsmöglichkeiten. Aber das nur nebenbei. Ich hoffe du kannst jetzt deinen Code so einbetten dass es zum gewünschten Resultat führt.
Gruss bully