Währungsformat, Nachkommastellen auf 2 setzen

[rob40]

Hallo zusammen,

EDIT:
ich habe nach einem csv-Import:

Code: Alles auswählen

123,6
28,54
-0,25
-230
-123,6
-9
1500

oder:

Code: Alles auswählen

123,60000 €
28,54000 €
-,25000 €
-230,00000 €
-123,60000 €
-9,00000 €
1.500,00000 €

Ich will:

Code: Alles auswählen

123,60 €
28,54 €
-,25 €
-123,60 €

Ich muß die Nachkommastellen MANUELL auf 2 setzen - erst dann klappt es -
wie mache ich das via Code?

Code: Alles auswählen

Sub TestZelleFormat
    'ZIEL:  2 Stellen nach dem Komma und €
    Dim sh As Object, c As Object
    sh = ThisComponent.CurrentController.ActiveSheet

    c = sh.getCellByPosition(2, 11) ' C12
    c.CellStyle = "Default"
    c.NumberFormat = 0

    If c.Type <> com.sun.star.table.CellContentType.VALUE Then
        c.Value = Val(c.String)
    End If

    Dim nf As Object, locale As New com.sun.star.lang.Locale
    locale.Language = "de"
    locale.Country = "DE"
    nf = ThisComponent.getNumberFormats()

    Dim fmt As String, id As Long
    fmt = "#,##0,00 [$€-de-DE];[RED]-#,##0,00 [$€-de-DE];0,00 [$€-de-DE]"
    id = nf.addNew(fmt, locale)

    c.NumberFormat = id
End Sub

Ich würde mich freuen, wenn jemand ein Tip hat.

Gruß Rob

[karolus]

Code: Alles auswählen

123,60000 €
28,54000 €
-,25000 €
-230,00000 €
-123,60000 €
-9,00000 €
1.500,00000 €

Ich will:

Code: Alles auswählen

123,60 €
28,54 €
-,25 €
-123,60 €

Seltsam … Wenn ich obiges Beispiel als csv importiere, bekomme ich exakt das Ergebnis in Calc das du dir wünscht, ohne irgendwelches zusammengewürfeltes Makrogeschwurbel!

Könnte also daran liegen daß DU beim csv-import ziemlich viel falsch machst?!

[rob40]

danke für Deine Antwort. (mir ist nicht klar, was Du mit Makrogeschwurbel meinst)

csv-import ziemlich viel falsch

das kann gut sein:

Code: Alles auswählen

Sub Import_Test_hhmm(srcFolder As String, dstFolder As String, ByRef outDoc As Object)
    On Error GoTo ErrHandler
    outDoc = Nothing
    Dim fsa As Object
    fsa = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")

    If Right(srcFolder, 1) <> "\" Then srcFolder = srcFolder & "\"
    If Right(dstFolder, 1) <> "\" Then dstFolder = dstFolder & "\"

    Dim files As Variant, file As Variant, firstCSV As String
    files = fsa.getFolderContents(ConvertToURL(srcFolder), False)
    firstCSV = ""
    For Each file In files
        If LCase(Right(file, 4)) = ".csv" Then
            firstCSV = file
            Exit For
        End If
    Next file
    If firstCSV = "" Then
        MsgBox "Keine CSV in " & srcFolder
        Exit Sub
    End If

    Dim t As Date, hh As String, mm As String, dstFileName As String
    t = Now
    hh = Right("0" & Hour(t), 2)
    mm = Right("0" & Minute(t), 2)
    dstFileName = "Test_" & hh & mm & ".csv"

    Dim dstPathNative As String, dstURL As String
    dstPathNative = dstFolder & dstFileName
    dstURL = ConvertToURL(dstPathNative)

    On Error Resume Next
    If fsa.exists(dstURL) Then fsa.kill(dstURL)
    On Error GoTo ErrHandler
    fsa.copy(firstCSV, dstURL)

    Dim args(2) As New com.sun.star.beans.PropertyValue
    args(0).Name = "FilterName": args(0).Value = "Text - txt - csv (StarCalc)"
    args(1).Name = "FilterOptions": args(1).Value = "59,34,76"
    args(2).Name = "ReadOnly": args(2).Value = False

    Dim doc As Object
    doc = StarDesktop.loadComponentFromURL(dstURL, "_blank", 0, args())
    If doc Is Nothing Then
        MsgBox "Import fehlgeschlagen."
        Exit Sub
    End If
    If Not doc.supportsService("com.sun.star.sheet.SpreadsheetDocument") Then
        MsgBox "Import fehlgeschlagen: Dokument ist kein Calc-Dokument."
        outDoc = Nothing
        Exit Sub
    End If

    outDoc = doc
    outDoc.calculateAll
    Wait 100
    Exit Sub

ErrHandler:
    MsgBox "Fehler beim Kopieren/Import: " & Err & " - " & Error$
    outDoc = Nothing
End Sub

Wohl durch Fehler beim Import sind in 2 Spalten die

Code: Alles auswählen

Nachkommastellen auf 5

und nehmen die Änderung auf 2 nicht dauerhaft an.
Wie erzwinge ich im code die Nachkommastellen auf 2 -
hast Du n Tip?

[karolus]

Hallo

Importiere deine …csv eben manuell und wenn du dann die passenden Optionen gefunden hast, kannst du diese mit folgendem Makro auslesen und in dein Import-makro einsetzen.

Code: Alles auswählen

Sub showFilterOptions
Dim args(),i%
	args() = thisComponent.getArgs
	for i = 0 to uBound(Args())
		if args(i).Name = "FilterOptions" then inputbox "","",args(i).value
	next
End Sub