Es gibt html-Tabellen, die man über die Zwischenablage (Linux wie Windows) als Textimport nicht in der vorgegebenen Spaltenstruktur in ein Calc-Tabellenblatt importieren kann. Es ist daher nicht möglich, während des Imports die Spalten zu markieren, deren Dezimalpunktzahlen in das lokale Format mit Dezimalkomma konvertiert werden müssten.
Als html-Import ist die Zeilen- und Spaltenstruktur zwar intakt, Dezimalpunktzahlen sind allerdings entweder als Text oder zu einem Datum konvertiert enthalten. Aus aktuellem Anlass (eine Datenbankausgabe lässt sich nicht beeinflussen) habe ich ein Makro geschrieben, das den Kollegen die Möglichkeit gibt, nachträglich die Werte zu konvertieren, um damit korrekt rechnen zu können.
Wenn überhaupt irgendwo anders ein Interesse daran besteht, will ich es gerne hier vorstellen. Ich wäre auch dankbar, wenn Fehler gefunden würden, die mir ganz sicher entgangen sind. Und natürlich bin ich offen für andere Sichtweisen und Algorithmen.
Hier ist der Code:
Code: Alles auswählen
Function ToCommaSepDecimals(oCell as object, vContent, _
iDecimals) as integer
REM Author: Volker Lenhardt
REM Last correction: 2011-05-19
REM
REM Converts a decimal point number string or a date string to a localised
REM decimal comma number. Leaves other cell contents alone.
REM
REM Parameters: oCell: cell object
REM vContent: type variant, returns the converted cell content,
REM can be numeric or string
REM iDecimals: number of decimal places (1 to 5)
REM
REM Returns:
REM original content returned content
REM 0 : string - vContent = original string
REM 1 : decimal comma number - vContent = original value
REM 2 : decimal point number string - vContent = new number value
REM 3 : date (unique number) - vContent = new number value
REM 4 : choice of numbers - vContent = string of numbers
REM
REM If the cell content is a formula, then 10 is added to the return value.
dim iRetVal as integer
dim iCurYear as integer
dim iYear as integer
dim iMonth as integer
dim iDay as integer
dim iComma as integer
dim iPoint as integer
dim iFormulaTen as integer
dim s as string
dim bMulti as boolean
dim i2DigitDateStart as integer
dim vValue
iRetVal = 0
iFormulaTen = 0
'Is the cell content a formula?
'It would start with = (ASCII 61).
if asc(oCell.getFormula()) = 61 then iFormulaTen = 10
vContent = oCell.getString() 'String representation of cell content
if not isNumeric(vContent) then
'Cell content = string
ToCommaSepDecimals = iFormulaTen
exit function
end if
if not isDate(vContent) then
'Cell content representation = number, but not a date
iComma = instr(vContent, ",")
iPoint = instr(vContent, ".")
select case iDecimals
case 3
if (iComma = 0 and iPoint = 0) then
vContent = val(vContent) / 1000
iRetVal = 2
else
vContent = oCell.getValue()
iRetVal = 1
end if
case else
if iPoint = len(vContent) - iDecimals then
vContent = val(vContent)
iRetVal = 2
else
vContent = oCell.getValue()
iRetVal = 1
end if
end select
else
'Cell content = date
vValue = oCell.getValue()
iRetVal = 0
iCurYear = year(date)
iYear = year(vValue)
iMonth = month(vValue)
iDay = day(vValue)
i2DigitDateStart = ThisComponent.NumberFormatSettings.TwoDigitDateStart
select case iDecimals
case 1
if iYear = 2000 then
vContent = iMonth
iRetVal = 3
elseif iYear = iCurYear and iMonth < 10 then
vContent = iDay + iMonth / 10
iRetVal = 3
end if
case 2
if iYear <> iCurYear then
if iYear >= i2DigitDateStart and _
iYear < i2DigitDateStart + 100 then
'In this case the month stems from the integer part,
'and the year from the decimal part.
vContent = iMonth + (iYear mod 100) / 100
iRetVal = 3
end if
else
'In this case the day most likely stems from the integer part,
'and the month from the decimal part.
vContent = iDay + iMonth / 100
iRetVal = 3
'There may be a second case:
'if the current year is greater than 2012 and the day equals 1:
'month from the integer, year from the decimal part.
if iDay = 1 and iCurYear > 2012 then
vContent = "# " & format(vContent, "0.00") & " # " & _
format(iMonth + (iYear mod 100) / 100, "0.00") & " # "
iRetVal = 4
end if
end if
case 4
if iDay = 1 then
vContent = iMonth + iYear / 10000
iRetVal = 3
end if
end select
end if
ToCommaSepDecimals = iRetVal + iFormulaTen
End Function
'-------------------------------------------------------------------------------
Function LocalNumber(sCellAddress as string, iSheetNr as integer, _
iDecs as integer)
REM Calc function to copy a cell content by converting a point separated
REM decimal number string or a date value to a comma separated decimal number.
REM
REM Parameters: sCellAddress: single cell (not a range), e.g. "$e$2" or "ac15",
REM as returned by the function 'zelle("address";e2)'
REM iSheetNr: sheet number (not the name)
REM as returned by the function 'zelle("sheet";e2)'
REM iDecs: = 2: all numeric entries have two decimals
REM = any other: numeric entries can have any decimals
REM
REM Returns: converted cell content as returned from ToCommaSepDecimals
dim oSheet as object
dim oCell as object
dim iType as integer
dim vContent as variant
if iDecs < 1 or iDecs > 5 then
LocalNumber = "Fehler: Dezimalstellenangabe nicht im Bereich 1 bis 5"
exit function
end if
oSheet = ThisComponent.getSheets().getByIndex(iSheetNr - 1)
oCell = oSheet.getCellRangeByName(sCellAddress)
iType = ToCommaSepDecimals(oCell, vContent, iDecs)
LocalNumber = vContent
End Function
'-------------------------------------------------------------------------------
Function LokalZahl(sCellAddress as string, iSheetNr as integer, _
iDecs as integer)
REM Alias for LocalNumber
LokalZahl = LocalNumber(sCellAddress, iSheetNr, iDecs)
End Function
'-------------------------------------------------------------------------------
Sub SelectionToLocalNumber()
REM Converts the point separated decimal number strings or date values of a
REM selection (single cell, one continuous range, multiple ranges) to comma
REM separated decimal numbers.
dim oDoc as object
dim oSels as object
dim aSelAddress
dim i as integer
dim oSheet as object
dim oCell as object
dim oCursor as object
dim aUsedArea as new com.sun.star.table.CellRangeAddress
dim lEndCol as long
dim lEndRow as long
dim c as long
dim r as long
dim vContent
dim iType as integer
dim iDecs as integer
dim aLocalSettings as new com.sun.star.lang.Locale
dim oNumberFormats as object
dim sNrFormatStr as string
dim iNrFormatId as long
oDoc = ThisComponent
if not oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") then
MsgBox " Dies ist kein Calc-Dokument! ", 16, "Abbruch"
exit sub
end if
oNumberFormats = oDoc.NumberFormats
iDecs = val(InputBox("Anzahl der Dezimalstellen (1 bis 5):", _
"Dezimalstellen", "2"))
if iDecs < 1 or iDecs > 5 then exit sub
sNrFormatStr = "0," & string(iDecs, "0")
iNrFormatId = oNumberFormats.queryKey(sNrFormatStr, aLocalSettings, true)
if iNrFormatId = -1 then iNrFormatId = _
oNumberFormats.addNew(sNrFormatStr, aLocalSettings)
oSels = oDoc.getCurrentSelection()
if oSels.supportsService("com.sun.star.sheet.SheetCellRange") then
'Can be a continuous cell range or a single cell.
redim aSelAddress(0)
aSelAddress(0) = oSels.getRangeAddress()
elseif oSels.supportsService("com.sun.star.sheet.SheetCellRanges") then
'Multiple discontinuous cell ranges.
redim aSelAddress(oSels.getCount() - 1)
for i = 0 to oSels.getCount() - 1
aSelAddress(i) = oSels.getByIndex(i).getRangeAddress()
next
end if
oSheet = oDoc.getSheets().getByIndex(aSelAddress(0).Sheet)
'Get the actually used area (highest row and column) to prevent
'too big ranges, e.g. if a column is selected as a whole.
oCell = oSheet.getCellByPosition(0, 0)
oCursor = oSheet.createCursorByRange(oCell)
oCursor.gotoEndOfUsedArea(True)
aUsedArea = oCursor.RangeAddress
for i = lbound(aSelAddress) to ubound(aSelAddress)
lEndCol = aSelAddress(i).EndColumn
if lEndCol > aUsedArea.EndColumn then lEndCol = aUsedArea.EndColumn
lEndRow = aSelAddress(i).EndRow
if lEndRow > aUsedArea.EndRow then lEndRow = aUsedArea.EndRow
for c = aSelAddress(i).StartColumn to lEndCol
for r = aSelAddress(i).StartRow to lEndRow
oCell = oSheet.getCellByPosition(c, r)
iType = ToCommaSepDecimals(oCell, vContent, iDecs)
select case iType
case 2, 3 'converted number value
oCell.setValue(vContent)
oCell.NumberFormat = iNrFormatId
case 4 'string of choices
oCell.setString(vContent)
case else
end select
next
next
next
End Sub
Die Funktion kann auf zweierlei Art benutzt werden:
- über das Makro SelectionToLocalNumber, das die Zellen im selektierten Bereich bearbeitet und das am besten über Extras->Optionen->Anpassen direkt erreichbar gemacht werden sollte.
- über die Calc-Funktion LocalNumber bzw. LokalZahl, die den Zellinhalt nicht verändert, sondern in originaler bzw. konvertierter Form kopiert.
ToCommaSepDecimals gibt zwei Werte zurück: einen Konvertierungsergebniscode und den vorgefundenen bzw. konvertierten Zellinhalt, damit einerseits LocalNumber einen Eintrag hat und andererseits SelectionToLocalNumber den Zellinhalt ändern und das Zahlenformat setzen kann.
Gruß
Volker
PS: geänderter Code 19.5.11 18:42