wizards/source/euro/Soft.xba

   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="Soft" script:language="StarBasic">Option Explicit
   4 REM  *****  BASIC  *****
   5
   6
   7 Sub CreateStyleEnumeration()
   8         EmptySelection()
   9         EmptyListbox(DialogModel.lstSelection)
  10         CurSheetName = oDocument.CurrentController.GetActiveSheet.Name
  11         MakeStyleEnumeration(False)
  12         DialogModel.lblSelection.Label = sTEMPLATES
  13 End Sub
  14
  15
  16 Sub MakeStyleEnumeration(bAddToListbox as Boolean)
  17 Dim m as integer
  18 Dim aStyleFormat as Object
  19 Dim Stylename as String
  20         StyleIndex = -1
  21         oStyles = oDocument.StyleFamilies.GetbyIndex(0)
  22         For m = 0 To oStyles.count-1
  23                 oStyle = oStyles.GetbyIndex(m)
  24                 StyleName = oStyle.Name
  25                 If CheckFormatType(oStyle) Then
  26                         If Not bAddToListBox Then
  27                                 AddSingleItemToListbox(DialogModel.lstSelection, Stylename)
  28                         Else
  29                                 SwitchNumberFormat(ostyle, oFormats, sEuroSign)
  30                         End If
  31                         StyleIndex = StyleIndex + 1
  32                         If StyleIndex &gt; Ubound(StyleRangeAssignMentList()) Then
  33                                 Redim Preserve StyleRangeAssignmentList(StyleIndex)
  34                         End If
  35                         StyleRangeAssignmentList(StyleIndex) =  &quot;&lt;STYLENAME&gt;&quot; &amp; Stylename &amp; &quot;&lt;/STYLENAME&gt;&quot; &amp; _
  36                                                                                                         &quot;&lt;DEFINED&gt;FALSE&lt;/DEFINED&gt;&quot; &amp; &quot;&lt;RANGES&gt;&lt;/RANGES&gt;&quot; &amp;_
  37                                                                                                         &quot;&lt;CELLCOUNT&gt;0&lt;/CELLCOUNT&gt;&quot; &amp;_
  38                                                                                                         &quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;
  39                 End If
  40         Next m
  41         If StyleIndex &gt; -1 Then
  42                 Redim Preserve StyleRangeAssignmentList(StyleIndex)
  43         Else
  44                 ReDim StyleRangeAssignmentList()
  45         End If
  46 End Sub
  47
  48
  49 Sub AssignRangestoStyle(StyleList(), SelList())
  50 Dim i as Integer
  51 Dim n as integer
  52 Dim LastIndex as Integer
  53 Dim CurStyleName as String
  54 Dim AssignString as String
  55         LastIndex = Ubound(StyleList())
  56         StatusValue = 0
  57         SetStatusLineText(sStsRELRANGES)
  58         For i = 0 To LastIndex
  59                 CurStyleName = StyleList(i)
  60                 n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0)
  61                 AssignString = StyleRangeAssignmentlist(n)
  62                 If IndexInArray(CurStyleName, SelList()) &lt;&gt; -1 Then
  63                         &apos; Style is selected
  64                         If FindPartString(AssignString, &quot;&lt;DEFINED&gt;&quot;, &quot;&lt;/DEFINED&gt;&quot;, 1) = &quot;FALSE&quot; Then
  65                                 AssignString = ReplaceString(AssignString, &quot;&lt;SELECTED&gt;TRUE&lt;/SELECTED&gt;&quot;, &quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;)
  66                                 AssignCellFormatRanges(n, AssignString, CurStyleName)
  67                         End If
  68                 Else
  69                         &apos; Style is not selected
  70                         If FindPartString(AssignString, &quot;&lt;SELECTED&gt;&quot;, &quot;&lt;/SELECTED&gt;&quot;, 1) = &quot;FALSE&quot; Then
  71                                 DeselectStyle(CurStyleName, n)
  72                         End If
  73                 End If
  74                 IncreaseStatusvalue(SBRELGET/(LastIndex+1))
  75         Next i
  76 End Sub
  77
  78
  79 Sub AssignCellFormatRanges(n as Integer, AssignString as String, CurStyleName as String)
  80 Dim oRanges() as Object
  81 Dim oRange as Object
  82 Dim oRangeAddress
  83 Dim oSheet as Object
  84 Dim StyleCellCount as Long
  85 Dim i as Integer
  86 Dim MaxIndex as Integer
  87 Dim RangeString as String
  88 Dim SheetName as String
  89 Dim RangeName as String
  90 Dim CellCountString as String
  91         StyleCellCount = 0
  92         RangeString = &quot;&lt;RANGES&gt;&quot;
  93         MaxIndex = oSheets.Count-1
  94         For i = 0 To MaxIndex
  95                 oSheet = oSheets(i)
  96                 SheetName = oSheet.Name
  97                 oRanges = osheet.CellFormatRanges.CreateEnumeration
  98                 While oRanges.hasMoreElements
  99                         oRange = oRanges.NextElement
 100                         If oRange.getPropertyState(&quot;NumberFormat&quot;) = 1 Then
 101                                 If oRange.CellStyle = CurStyleName Then
 102                                         oRangeAddress = oRange.RangeAddress
 103                                         RangeName = RetrieveRangeNamefromAddress(oRange)
 104                                         RangeString = RangeString &amp; RangeName &amp; &quot;,&quot;
 105                                         StyleCellCount = StyleCellCount + CountRangeCells(oRange)
 106                                 End If
 107                         End If
 108                 Wend
 109         Next i
 110         If StyleCellCount &gt; 0 Then
 111                 TotCellCount = TotCellCount + StyleCellCount
 112                 RangeString = RTrimStr(RangeString,&quot;,&quot;)
 113                 RangeString = RangeString &amp; &quot;&lt;/RANGES&gt;&quot;
 114                 CellCountString = &quot;&lt;CELLCOUNT&gt;&quot; &amp; StyleCellCount &amp; &quot;&lt;/CELLCOUNT&quot;
 115                 AssignString = ReplaceString(AssignString, RangeString,&quot;&lt;RANGES&gt;&lt;/RANGES&gt;&quot;)
 116                 AssignString = ReplaceString(AssignString, CellCountString,&quot;&lt;CELLCOUNT&gt;0&lt;/CELLCOUNT&gt;&quot;)
 117         End If
 118         AssignString = ReplaceString(AssignString, &quot;&lt;DEFINED&gt;TRUE&lt;/DEFINED&gt;&quot;, &quot;&lt;DEFINED&gt;FALSE&lt;/DEFINED&gt;&quot;)
 119         StyleRangeAssignmentList(n)     = AssignString
 120 End Sub
 121
 122
 123 &apos; deletes a styletemplate from the Collection that selects the ranges
 124 Sub DeselectStyle(DeSelStyleName as String, n as Integer)
 125 Dim i as Integer
 126 Dim RangeName as String
 127 Dim SelectString as String
 128 Dim AssignString as String
 129 Dim StyleRangeList() as String
 130 Dim MaxIndex as Integer
 131         SelectString =&quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;
 132         AssignString = StyleRangeAssignmentList(n)
 133         RangeString = FindPartString(AssignString,&quot;&lt;RANGES&gt;&quot;,&quot;&lt;/RANGES&gt;&quot;,1)
 134         StyleRangeList() = ArrayoutofString(RangeString,&quot;,&quot;)
 135         MaxIndex = Ubound(StyleRangeList())
 136         For i = 0 To MaxIndex
 137                 RangeName = StyleRangeList(i)
 138                 If oSelRanges.HasbyName(RangeName) Then
 139                         oSelRanges.RemovebyName(RangeName)
 140                 End If
 141         Next i
 142         AssignString = ReplaceString(AssignString, &quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;, &quot;&lt;SELECTED&gt;TRUE&lt;/SELECTED&gt;&quot;)
 143         StyleRangeAssignmentList(n) = AssignString
 144 End Sub
 145
 146
 147 Function RetrieveRangeNamefromAddress(oRange as Object) as String
 148 Dim Rangename as String
 149 Dim oAddressRanges as Object
 150         oAddressRanges = oDocument.createInstance(&quot;com.sun.star.sheet.SheetCellRanges&quot;)
 151         oAddressRanges.InsertbyName(&quot;&quot;,oRange)
 152         Rangename = oAddressRanges.RangeAddressesasString
 153 &apos;  Msgbox &quot;Adresse: &quot; &amp; oRangeAddress.StartColumn &amp; &quot; ; &quot; &amp; oRangeAddress.EndColumn &amp; &quot; ; &quot; &amp; oRangeAddress.StartRow &amp; &quot; ; &quot; &amp; oRangeAddress.EndRow &amp; chr(13) &amp; RangeName
 154 &apos;  oAddressRanges.RemovebyName(RangeName)
 155         RetrieveRangeNamefromAddress = Rangename
 156 End Function
 157
 158
 159 &apos; creates a sheet object from an according sectionname
 160 Function RetrieveSheetoutofRangeName(TableText as String)
 161 Dim DescriptionList() as String
 162 Dim SheetName as String
 163 Dim MaxIndex as integer
 164         &apos; find out in which sheet the range is
 165         DescriptionList() = ArrayOutofString(TableText,&quot;.&quot;,MaxIndex)
 166         SheetName = DescriptionList(0)
 167         SheetName = DeleteStr(SheetName,&quot;&apos;&quot;)
 168         &apos; set the viewcursor on this sheet
 169         RetrieveSheetoutofRangeName = oSheets.GetbyName(SheetName)
 170 End Function
 171
 172
 173 &apos; creates a rangeobject from an according rangename
 174 Function RetrieveRangeoutofRangeName(TableText as String)
 175         oSheet = RetrieveSheetoutofRangeName(TableText)
 176         oRange = oSheet.GetCellRangebyName(TableText)
 177         RetrieveRangeoutofRangeName = oRange
 178 End Function
 179
 180
 181 Sub ConvertTheSoftWay(StyleList(), bDeSelect as Boolean)
 182 Dim i as Integer
 183 Dim l as Integer
 184 Dim s as Integer
 185 Dim n as Integer
 186 Dim CurStyleName as String
 187 Dim RangeName as String
 188 Dim OldStatusValue as Integer
 189 Dim LastIndex as Integer
 190 Dim oSelListbox as Object
 191 Dim StyleRangeList() as String
 192 Dim MaxIndex as Integer
 193         oSelListbox = DialogConvert.GetControl(&quot;lstSelection&quot;)
 194         LastIndex = Ubound(StyleList())
 195         OldStatusValue = StatusValue
 196         For i = 0 To LastIndex
 197                 CurStyleName = StyleList(i)
 198                 oStyle = oStyles.GetbyName(CurStyleName)
 199                 StyleRangeList() = GetAssignedRanges(CurStyleName, n)
 200                 MaxIndex = Ubound(StyleRangeList())
 201                 For s = 0 To MaxIndex
 202                         RangeName = StyleRangeList(s)
 203                         oRange = RetrieveRangeoutofRangeName(RangeName)
 204                         If oRange.getPropertyState(&quot;NumberFormat&quot;) = 1 Then
 205                                 &apos; Range is hard formatted
 206                                 ConvertCellCurrencies(oRange)
 207                                 CurCellCount = CountRangeCells(oRange)
 208                         End If
 209                         IncreaseStatusvalue((CurCellCount/TotCellCount)*(95-OldStatusValue))
 210                         If bDeSelect Then
 211                                 &apos; Note: On Problems see Bug #73157
 212                                 If oSelRanges.HasbyName(RangeName) Then
 213                                         oSelRanges.RemovebyName(RangeName)
 214                                         oDocument.CurrentController.Select(oSelRanges)
 215                                 End If
 216                         End If
 217                 Next s
 218                 SwitchNumberFormat(ostyle, oFormats, sEuroSign)
 219                 StyleRangeAssignmentList(n) = &quot;&quot;
 220                 l = GetItemPos(oSelListBox.Model, CurStyleName)
 221                 oSelListbox.RemoveItems(l,1)
 222         Next
 223 End Sub
 224
 225
 226 Function GetAssignedRanges(CurStyleName as String, n as Integer)
 227 Dim StyleRangeList() as String
 228 Dim RangeString as String
 229 Dim AssignString as String
 230         n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0)
 231         If n &lt;&gt; -1 Then
 232                 AssignString = StyleRangeAssignmentList(n)
 233                 RangeString = FindPartString(AssignString,&quot;&lt;RANGES&gt;&quot;, &quot;&lt;/RANGES&gt;&quot;,1)
 234                 If RangeString &lt;&gt; &quot;&quot; Then
 235                         StyleRangeList() = ArrayoutofString(RangeString,&quot;,&quot;)
 236                 End If
 237         End If
 238         GetAssignedRanges() = StyleRangeList()
 239 End Function</script:module>