ristoi
General User
Joined: 25 Aug 2009
Posts: 24
Location: Järvenpää
|
 Posted: Thu Jul 08, 2010 3:28 am Post subject: Engineering format for selected Calc cells' values |
 |
|
Here is routines for postprocessing of values in Calc cell to engineering format, i.e. scientific format with modulo 3 exponents like -003, +000, +003 ...
Limitation here is that if value in a cell is changed afterwards out of its current decade, format will be not correct anymore. Value still remains correct. So cell (range) need to select again and run AlueTekniseksi again.
Short explanation of routines:
- Main: this is just example how to use other functions but may be useful as such. It use active document and its currently selected range calling Aluetekniseksi subroutine.
- Aluetekniseksi take range as oAlue argument and go through all of its cell in two level loops. Calling SoluunTekninenMuotoilu subroutine happens in inner loop.
- SoluunTekninenMuotoilu routine set format of cell such that it shows value in engineering format. This happens calling couple of subroutines, namely iPotenssinJj and sEksponenttiMuoto for determination of length '00"-string left to decimal separator by finding out remainder of the exponent divided by 3, and FindCreateNumberFormatStyle (by Andrew Pitoynak) for determining format style number for possible new format code. At the end SoluunTekninenMuotoilu set this format number to the cells number format property.
I suppose this program is working with many different locales (other than suomi) because sEksponenttiMuoto function use locale desimal separator in sDesimaalierotin variable and in format string.
I hope this gives some relief to those who has been waiting for engineering notation to Calc over too many years.
If somebody is willing to change this routines to working in Writer it is welcome as is other corrections and enhancements.
Regards
Risto
| Code: | REM ***** BASIC *****
Option Explicit
Sub Main
AlueTekniseksi (thisComponent.currentSelection())
End Sub
Sub AlueTekniseksi (oAlue as Object)
REM Käsitellään (valittu) alue muuntaen lukumuotoilut teknisiksi
REM Kiitokset Sasa Kelecevicille Sub FillCells -rutiinista
DIM lC as Long, lR as Long
DIM oSarakkeet as Object, oRivit as Object, oSolu as Object
REM haetaan oAlueen sarake- ja rivimäärät
oSarakkeet=oAlue.Columns
oRivit=oAlue.Rows
REM käytään sisäkkäisissä silmukoissa läpi alueen solut
For lC= 0 To oSarakkeet.getCount-1
For lR = 0 To oRivit.getCount-1
oSolu=oAlue.getCellByPosition(lC,lR)
SoluunTekninenMuotoilu (oSolu)
Next lR
Next lC
End Sub 'AlueTekniseksi
Sub SoluunTekninenMuotoilu (oSolu as Object)
REM bSoluunTekninenMuotoilu-rutiini muotoilee oSolun
REM tekniseen lukumuotoon kolmella jaollisin potenssein
REM Kiitokset Sasa Kelecevicille ja Andrew Pitonyakille
REM (RJ)
DIM dLuku as Double
DIM iLuku as Integer
DIM sMuotoKoodi as String
DIM lTyylinro as Long
dLuku = oSolu.getValue()
iLuku = iPotenssinJj (dLuku, 3)
REM tehdään pieni korjaus negatiivisille eksponenteille
If (iluku<0) then iLuku=iLuku + 3
sMuotoKoodi = sEksponenttiMuoto(iLuku+1)
REM Määritellään/noudetaan tyylin numero
lTyylinro=FindCreateNumberFormatStyle(sMuotoKoodi)
REM Muotoillaan solu
oSolu.NumberFormat=lTyylinro
End Sub 'SoluunTekninenMuotoilu
Function sEksponenttiMuoto(iNrotvas as Integer, Optional iPituus as Integer) as String
REM funktio sEksponenttiMuoto tuottaa eksponenttilukumuotokoodin, jossa
REM - iNrotvas määrittää desimaalipisteestä vasemmalle olevien numeroiden määrän (0...20)< iPituus
REM - iPituus on näytettävien numeroiden määrä (oletus 5)
REM
REM (RJ)
DIM iNrlkm as Integer 'iPituus muuttujassa
DIM sDesimaalierotin as String 'piste tai pilkku maaasetuksista riippuen
REM Format antaa ohjelmiston maa-asetusen mukaisen erottimen:
sDesimaalierotin = Mid(Format(1.01, "Standard"),2,1)
REM asetetaan esitettävien numeroiden lukumäärä
If IsMissing (iPituus) then
iNrlkm = 5
elseIf iPituus > -1 and iPituus < 20 then
iNrlkm = iPituus
else
iNrlkm = 5
EndIf
REM asetetaan pilkusta vasemmalle näytettävien numeroiden lukumäärä
IF iNrotvas > iNrlkm or iNrotvas < 0 then
iNrotvas = iNrlkm/2
EndIf
sEksponenttiMuoto = _
String(iNrotvas,"0") & sDesimaalierotin & String(iNrlkm-iNrotvas,"0") & "E+000"
End Function 'sEksponenttiMuoto
Function iPotenssinJj (dLuku as Double, Optional iJakaja as Integer) as Integer
REM iPotenssinJj-funktio määrittää dLuvun 10-logaritmin jakojäännöksen 3:lla jaettaessa
REM tämä vastaa 1,234E+nnn -muotoisen dLuvun nnn-eksponentin jakojäännöstä
REM iJakaja-argumentilla voi sitten saada muidenkin pienten lukujen jäkojäännöksiä
REM (RJ)
DIM dTemp as Double
DIM iJa as Integer, iTmp as Integer
REM estetään virhe
IF Abs(dLuku)=0 then
iPotenssinJj = 0
Exit Function
EndIf
REM käsitellään toisen argumentin puuttuminen
IF IsMissing (iJakaja) then
iJa = 3
else
iJa = iJakaja
EndIf
REM tarkistetaan kohtuullisuus:
If iJa <2 or iJa > 9 then
iJa = 3
EndIf
dTemp = Abs(dLuku)
dTemp = Log(Abs(dLuku))/Log(10)
iTmp = Int(Log(Abs(dLuku))/Log(10))
iTmp = iTmp Mod iJa
iPotenssinJj = iTmp
End Function 'iPotenssinJj
'Author: Andrew Pitonyak
'email: andrew@pitonyak.org
Function FindCreateNumberFormatStyle (_
sFormat As String, Optional doc, Optional locale)
Dim oDoc As Object
Dim aLocale As New com.sun.star.lang.Locale
Dim oFormats As Object
Dim formatNum As Integer
oDoc = IIf(IsMissing(doc), ThisComponent, doc)
oFormats = oDoc.getNumberFormats()
'If you choose to query on types, you need to use the type
'com.sun.star.util.NumberFormat.DATE
'I could set the locale from values stored at
'http://www.ics.uci.edu/pub/ietf/http/related/iso639.txt
'http://www.chemie.fu-berlin.de/diverse/doc/ISO_3166.html
'I use a NULL locale and let it use what ever it likes.
'First, see if the number format exists
If ( Not IsMissing(locale)) Then
aLocale = locale
End If
formatNum = oFormats.queryKey (sFormat, aLocale, TRUE)
'MsgBox "Current Format number is" & formatNum 'Commented out by RJ
'If the number format does not exist then add it
If (formatNum = -1) Then
formatNum = oFormats.addNew(sFormat, aLocale)
If (formatNum = -1) Then formatNum = 0
'MsgBox "new Format number is " & formatNum 'Commented out by RJ
End If
FindCreateNumberFormatStyle = formatNum
End Function |
|
|
