home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 March / PCWorld_2003-03_cd.bin / Software / Vyzkuste / openoffice / f_0283 / Hard.xba < prev    next >
Extensible Markup Language  |  2002-02-19  |  7KB  |  232 lines

  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Hard" script:language="StarBasic">REM  *****  BASIC  *****
  4. Option Explicit
  5.  
  6.  
  7. Sub CreateRangeList()
  8. Dim MaxIndex as Integer
  9.     MaxIndex = -1
  10.     EnableStep1DialogControls(False, False, False)
  11.     EmptySelection()
  12.     DialogModel.lblSelection.Label = sCURRRANGES      '"W├ñhrungsbereiche:"
  13.     EmptyListbox(DialogModel.lstSelection)
  14.     oDocument.CurrentController.Select(oSelRanges)
  15.     If (DialogModel.optSheetRanges.State = 1) AND (DialogModel.chkComplete.State <> 1) Then
  16.         ' Ist das Sheet Grundlage f├╝r die Bearbeitung?
  17.         oStatusline.SetText(sStsRELRANGES)                '"Erfassung der relevanten Bereiche..."
  18.         osheet = oDocument.CurrentController.GetActiveSheet
  19.         oRanges = osheet.CellFormatRanges.createEnumeration()
  20.         MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, False)
  21.         If MaxIndex > -1 Then
  22.             ReDim Preserve RangeList(MaxIndex)
  23.         End If
  24.     Else
  25.         CreateRangeEnumeration(False)
  26.         bRangeListDefined = True
  27.     End If
  28.     EnableStep1DialogControls(True, True, True)
  29.     oStatusline.SetText("")
  30. End Sub
  31.  
  32.  
  33. Sub CreateRangeEnumeration(bAutopilot as Boolean)
  34. Dim i as Integer
  35. Dim MaxIndex as integer
  36. Dim sStatustext as String
  37.     MaxIndex = -1
  38.     If Not bRangeListDefined Then
  39.         ' Die Ranges sind noch nicht definiert
  40.         oSheets = oDocument.Sheets
  41.         For i = 0 To oSheets.Count-1
  42.             oSheet = oSheets.GetbyIndex(i)
  43.             If bAutopilot Then
  44.                 IncreaseStatusValue(SBRELGET/osheets.Count)
  45.             Else
  46.                 sStatustext = ReplaceString(sStsRELSHEETRANGES,Str(i+1),"%1Number%1")
  47.                 sStatustext = ReplaceString(sStatusText,oSheets.Count,"%2TotPageCount%2")
  48.                 oStatusline.SetText(sStatusText)
  49.             End If
  50.             oRanges = osheet.CellFormatRanges.createEnumeration
  51.             MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, bAutopilot)
  52.         Next i
  53.     Else
  54.         If Not bAutoPilot Then
  55.             oStatusline.SetText(sStsRELRANGES)      '"Erfassung der relevanten Bereiche..."
  56.             ' Die Ranges sind schon definiert
  57.             For i = 0 To Ubound(RangeList())
  58.                 If RangeList(i) <> "" Then
  59.                     AddSingleItemToListBox(DialogModel.lstSelection, RangeList(i))
  60.                 End If
  61.             Next
  62.         End If
  63.     End If
  64.     If MaxIndex > -1 Then
  65.         ReDim Preserve RangeList(MaxIndex)
  66.     Else
  67.         ReDim RangeList()
  68.     End If
  69.     Rangeindex = MaxIndex
  70. End Sub
  71.     
  72.     
  73. Function AddSheetRanges(oRanges as Object, r as Integer, oSheet as Object, bAutopilot)
  74. Dim RangeName as String
  75. Dim AddtoList as Boolean
  76. Dim iCurStep as Integer
  77. Dim MaxIndex as Integer
  78.     iCurStep = DialogModel.Step
  79.     While oRanges.hasMoreElements
  80.         oRange = oRanges.NextElement
  81.         AddToList = CheckFormatType(oRange)
  82.         If AddToList Then
  83.             RangeName = RetrieveRangeNamefromAddress(oRange)
  84.             TotCellCount = TotCellCount + CountRangeCells(oRange)
  85.             If Not bAutoPilot Then
  86.                 AddSingleItemToListbox(DialogModel.lstSelection, RangeName)
  87.             End If
  88.             ' The Ranges are only passed to an Array when the whole Document is the basis
  89.             ' Redimension the RangeList Array if necessary
  90.             MaxIndex = Ubound(RangeList())
  91.             r = r + 1
  92.             If r > MaxIndex Then
  93.                 MaxIndex = MaxIndex + SBRANGEUBOUND
  94.                 ReDim Preserve RangeList(MaxIndex)
  95.             End If
  96.             RangeList(r) = RangeName
  97.         End If
  98.     Wend
  99.     AddSheetRanges = r
  100. End Function
  101.  
  102.  
  103. ' F├╝gt einen Bereich zur selektierten Kollektion hinzu
  104. Sub SelectRange()
  105. Dim i as Integer
  106. Dim RangeName as String
  107. Dim SelItem as String
  108. Dim CurRange as String
  109. Dim SheetRangeName as String
  110. Dim DescriptionList() as String
  111. Dim MaxRangeIndex as Integer
  112. Dim StatusValue as Integer
  113.     StatusValue = 0
  114.     MaxRangeIndex = Ubound(SelRangeList())
  115.     CurSheetName = oSheet.Name
  116.     For i = 0 To MaxRangeIndex
  117.         SelItem = SelRangeList(i)
  118.         ' Is the Range already included in the collection?
  119.         oRange = RetrieveRangeoutOfRangename(SelItem)
  120.         TotCellCount = TotCellCount + CountRangeCells(oRange)
  121.         DescriptionList() = ArrayOutofString(SelItem,".",1)
  122.         SheetRangeName = DeleteStr(DescriptionList(0),"'")
  123.         If SheetRangeName = CurSheetName Then
  124.             oSelRanges.InsertbyName("",oRange)
  125.         End If
  126.         IncreaseStatusValue(SBRELGET/MaxRangeIndex)
  127.     Next i
  128. End Sub
  129.  
  130.  
  131. Sub ConvertThehardWay(ListboxList(), SwitchFormat as Boolean, bRemove as Boolean)
  132. Dim i as Integer ' r, a
  133. Dim AddCells as Long
  134. Dim OldStatusValue as Single
  135. Dim RangeName as String
  136. Dim LastIndex as Integer
  137. Dim oSelListbox as Object
  138.  
  139.     oSelListbox = DialogConvert.GetControl("lstSelection")
  140.     Lastindex = Ubound(ListboxList())
  141.     If TotCellCount > 0 Then
  142.         OldStatusValue = StatusValue
  143.         ' Harte Formatierung
  144.         For i = 0 To LastIndex
  145.             RangeName = ListboxList(i)
  146.             oRange = RetrieveRangeoutofRangeName(RangeName)
  147.             ConvertCellCurrencies(oRange)
  148.             If bRemove Then
  149.                 If oSelRanges.HasbyName(RangeName) Then
  150.                     oSelRanges.RemovebyName(RangeName)
  151.                     oDocument.CurrentController.Select(oSelRanges)    
  152.                 End If
  153.             End If
  154.             If SwitchFormat Then
  155.                 If oRange.getPropertyState("NumberFormat") <> 1 Then
  156.                     ' Range Ist hart formatiert
  157.                     SwitchNumberFormat(oRange, oFormats, sEuroSign)' "Γé¼")
  158.                 End If
  159.             Else
  160.                 SwitchNumberFormat(oRange, oFormats, sEuroSign) '"Γé¼"
  161.             End If
  162.             AddCells = CountRangeCells(oRange)
  163.             CurCellCount = AddCells
  164.             IncreaseStatusValue((CurCellCount/TotCellCount)*(100-OldStatusValue))
  165.             If bRemove Then
  166.                 RemoveListBoxItemByName(oSelListbox.Model,Rangename)
  167.             End If
  168.         Next
  169.     End If
  170. End Sub
  171.  
  172.  
  173. Sub ConvertCellCurrencies(oRange as Object)
  174. Dim oValues as Object
  175. Dim oCells as Object
  176. Dim oCell as Object
  177.       oValues = oRange.queryContentCells(com.sun.star.sheet.CellFlags.VALUE)
  178.     If (oValues.Count > 0) Then
  179.         oCells = oValues.Cells.createEnumeration
  180.         While oCells.hasMoreElements
  181.             oCell = oCells.nextElement
  182.             ModifyObjectValuewithCurrFactor(oCell)
  183.         Wend
  184.     End If
  185. End Sub
  186.  
  187.  
  188. Sub ModifyObjectValuewithCurrFactor(oDocObject as Object)
  189. Dim oDocObjectValue as double
  190.     oDocObjectValue = oDocObject.Value
  191.     oDocObject.Value = Round(oDocObjectValue/CurrFactor, 2)
  192. End Sub
  193.  
  194.  
  195. Function CheckIfRangeisCurrency(FormatObject as Object)
  196. Dim oFormatofObject() as Object
  197.     ' Retrieve the Format of the Object
  198.     On Local Error GoTo NOKEY
  199.     oFormatofObject() = oFormats.getByKey(FormatObject.NumberFormat)
  200.     On Local Error GoTo 0            
  201.  
  202.     ' Typ und W├ñhrungssymbol des Numberformats heraussuchen
  203.     ' Todo: ├£berpr├╝fe, ob diese beiden Zeilen nicht eleganter gehen
  204.      CheckIfRangeIsCurrency = INT(oFormatofObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY
  205.     Exit Function
  206. NOKEY:
  207.     CheckIfRangeisCurrency = False
  208.     Resume CLERROR
  209.     CLERROR:
  210. End Function
  211.  
  212.  
  213. Function CountColumnsForRow(IndexArray() as String, Row as Integer)
  214. Dim i as Integer
  215. Dim NoNulls as Boolean
  216.     For i = 1 To Ubound(IndexArray,2)
  217.         If IndexArray(Row,i)= "" Then
  218.             NoNulls = False
  219.             Exit For
  220.         End If
  221.     Next
  222.     CountColumnsForRow = i
  223. End Function
  224.  
  225.  
  226. Function CountRangeCells(oRange as Object) As Long
  227. Dim oRangeAddress as Object
  228. Dim LocCellCount as Long
  229.     oRangeAddress = oRange.RangeAddress
  230.     LocCellCount = (oRangeAddress.EndColumn - oRangeAddress.StartColumn + 1) * (oRangeAddress.EndRow - oRangeAddress.StartRow + 1)
  231.     CountRangeCells = LocCellCount
  232. End Function</script:module>