Hej Om du vet vad du har för avdelare så kan du köra en separation på dem, varför behöver du spara ner exakt hur långa fält du har? Du får väl "padda" värdet med space. Lämpligen har du en function som fixar det: Hej och tackar för svaren.Problem med att spara textfil i Excel
Jag försöker spara en semikolonseparerad textfil som jag importerat till excel.
I excel ska man kunna ta bort och lägga till rader för att sedan spara till en ny semikolonseparerad textfil.
När filen är importerad och man provar spara ser den ok ut, se nedan:
23568;000;9999999999;OLLE BERG ;0258741;ALLT OK; ;
När jag sedan skriver in en ny rad och sparar får jag följande utseende på den raden:
23568;000;9999999999;OLLE BERG;0258741;ALLT OK;;
Hur får man formatteringen som på den övre raden när man sparar.
Tacksam för svar.
Den kod jag har ser ut så här.
<Code>
Private Sub saveB_Click()
Dim strFilename As String
Dim sRow As String
Dim nCol As Long
Dim nRow As Long
Dim nFile As Integer
Dim fName As String
Dim sFileName As Variant
Dim tempStr As String
Dim newStr2 As String
Dim newStr3 As String
Dim newStr4 As String
Dim Lastrow As Integer
Const DELIM As String = ";"
Call TaBortTommaRader
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
sFileName = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If sFileName = False Then Exit Sub
newStr = InStrRev(sFileName, "\")
newStr2 = Mid(sFileName, newStr + 1)
newStr3 = InStrRev(newStr2, ".")
newStr4 = Left(newStr2, newStr3 - 1)
Application.DisplayAlerts = False
ThisWorkbook.SaveAs sFileName
Application.DisplayAlerts = True
fName = newStr4 & ".txt"
nFile = FreeFile
Open ActiveWorkbook.Path & "\" & fName For Output As #nFile
With ActiveSheet.UsedRange
For nRow = 2 To Lastrow
sRow = ""
For nCol = 1 To 8
If sRow <> "" Then sRow = sRow & DELIM
sRow = sRow & CStr(.Cells(nRow, nCol))
Next nCol
Print #nFile, sRow
Next nRow
End With
Close #nFile
End Sub
</Code>Sv: Problem med att spara textfil i Excel
/EmmaSv: Problem med att spara textfil i Excel
Private Function LeftPadCell(cellValue As String, n As Long) As String
LeftPadCell = Space(n)
Mid(LeftPadCell, 1, n) = cellValue
End Function
resultString = LeftPadCell("OLLE", 30)
Sv:Problem med att spara textfil i Excel
Lyckades lösa detta med denna funktion.
<Code>
Sub ExportRangeAsFixedText(SourceWB As String, _
SourceWS As String, SourceAddress As String, _
TargetFile As String, LeftAlign As Boolean, _
SaveValues As Boolean, _
AppendToFile As Boolean)
Dim SourceRange As Range
Dim A As Integer
Dim aCount As Integer
Dim ColWidth As Integer
Dim eCount As Long
Dim r As Long
Dim c As Integer
Dim totr As Long
Dim pror As Long
Dim fn As Integer
Dim LineString As String
Dim tLine As String
eCount = 0
Set SourceRange = Range(SourceAddress)
fn = FreeFile
Open TargetFile For Output As #fn
On Error GoTo 0
' Kollar antal rader
totr = 0
For A = 1 To SourceRange.Areas.Count
totr = totr + SourceRange.Areas(A).Rows.Count
Next A
' Skriver textfil med fixerad längd
pror = 0
For A = 1 To SourceRange.Areas.Count
For r = 1 To SourceRange.Areas(A).Rows.Count
LineString = ""
For c = 1 To SourceRange.Areas(A).Columns.Count
ColWidth = CInt(SourceRange.Areas(A).Columns(c).ColumnWidth)
tLine = ""
On Error Resume Next
If SaveValues Then
tLine = SourceRange.Areas(A).Cells(r, c).Value
Else
End If
On Error GoTo 0
' Skapar sträng med fixerad storlek
If Len(tLine) > ColWidth Then
eCount = eCount + 1
Else
If LeftAlign Then
tLine = tLine & Space(ColWidth - Len(tLine)) & ";"
Else
tLine = Space(ColWidth - Len(tLine)) & tLine
End If
End If
LineString = LineString & tLine
Next c
If Len(LineString) > 1 Then LineString = Left(LineString, Len(LineString) - 1)
If LineString = "" Then
Print #fn,
Else
Print #fn, LineString
End If
Next r
Next A
Close #fn
End Sub
</Code>