Forum at OOoForum.orgThe Forum
 [Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register
 [Profile]   [Log in to check your private messages]   [Log in

Engineering format for selected Calc cells' values

Post new topic   Reply to topic Forum Index -> Code Snippets
View previous topic :: View next topic  
Author Message
General User
General User

Joined: 25 Aug 2009
Posts: 26
Location: Järvenpää

PostPosted: Thu Jul 08, 2010 3:28 am    Post subject: Engineering format for selected Calc cells' values Reply with quote

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.


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
     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
            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


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
   REM Muotoillaan solu
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   (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
      iNrlkm = 5
   REM asetetaan pilkusta vasemmalle näytettävien numeroiden lukumäärä
   IF iNrotvas > iNrlkm or iNrotvas < 0 then
      iNrotvas = iNrlkm/2
   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
   REM käsitellään toisen argumentin puuttuminen
   IF IsMissing (iJakaja) then
      iJa = 3
      iJa = iJakaja
   REM tarkistetaan kohtuullisuus:
   If iJa <2 or iJa > 9 then
      iJa = 3
   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
Function FindCreateNumberFormatStyle (_
  sFormat As String, Optional doc, Optional locale)
  Dim oDoc As Object
  Dim aLocale As New
  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
  'I could set the locale from values stored at
  '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
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic Forum Index -> Code Snippets All times are GMT - 8 Hours
Page 1 of 1

Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum

Powered by phpBB © 2001, 2005 phpBB Group