Sub
exportToSMP()
Dim
i
As
Long
, j
As
Long
, lastRow
As
Long
, lastcol
As
Long
, rLastRow
As
Range
Dim
strRow
As
String
, vtFileName
As
Variant
, FF
As
Integer
vtFileName =
""
Do
vtFileName = Application.GetSaveAsFilename(,
"*.csv,*.csv,*.smp,*.smp,*.*,*.*"
)
If
vtFileName =
False
Then
Exit
Sub
If
Dir(vtFileName) <>
""
Then
If
MsgBox(
"Die Datei existiert bereits, "
& _
"soll sie überschrieben werden?"
, vbYesNo) = vbYes
Then
Exit
Do
End
If
Loop
While
Dir(vtFileName) <>
""
With
Worksheets(
"Export"
)
Set
rLastRow = .Cells.Find(
"*"
, , xlValues, xlWhole, xlByRows, xlPrevious)
If
Not
rLastRow
Is
Nothing
Then
lastRow = rLastRow.Row
lastcol = .Cells.Find(
"*"
, , xlValues, xlWhole, xlByColumns, xlPrevious).Column
FF = FreeFile()
Open vtFileName
For
Output
As
#FF
For
i = 1
To
lastRow
strRow =
""
For
j = 1
To
lastcol
strRow = strRow & .Cells(i, j) &
";"
Next
strRow = Left(strRow, Len(strRow) - 1)
Print #FF, strRow
Next
Close #FF
End
If
End
With
End
Sub