summaryrefslogtreecommitdiffstats
path: root/wizards/source/euro/Soft.xba
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 16:51:28 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-27 16:51:28 +0000
commit940b4d1848e8c70ab7642901a68594e8016caffc (patch)
treeeb72f344ee6c3d9b80a7ecc079ea79e9fba8676d /wizards/source/euro/Soft.xba
parentInitial commit. (diff)
downloadlibreoffice-940b4d1848e8c70ab7642901a68594e8016caffc.tar.xz
libreoffice-940b4d1848e8c70ab7642901a68594e8016caffc.zip
Adding upstream version 1:7.0.4.upstream/1%7.0.4upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to '')
-rw-r--r--wizards/source/euro/Soft.xba256
1 files changed, 256 insertions, 0 deletions
diff --git a/wizards/source/euro/Soft.xba b/wizards/source/euro/Soft.xba
new file mode 100644
index 000000000..eed7bd030
--- /dev/null
+++ b/wizards/source/euro/Soft.xba
@@ -0,0 +1,256 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
+<!--
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+-->
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Soft" script:language="StarBasic">Option Explicit
+REM ***** BASIC *****
+
+
+Sub CreateStyleEnumeration()
+ EmptySelection()
+ EmptyListbox(DialogModel.lstSelection)
+ CurSheetName = oDocument.CurrentController.GetActiveSheet.Name
+ MakeStyleEnumeration(False)
+ DialogModel.lblSelection.Label = sTEMPLATES
+End Sub
+
+
+Sub MakeStyleEnumeration(bAddToListbox as Boolean)
+Dim m as integer
+Dim aStyleFormat as Object
+Dim Stylename as String
+ StyleIndex = -1
+ oStyles = oDocument.StyleFamilies.GetbyIndex(0)
+ For m = 0 To oStyles.count-1
+ oStyle = oStyles.GetbyIndex(m)
+ StyleName = oStyle.Name
+ If CheckFormatType(oStyle) Then
+ If Not bAddToListBox Then
+ AddSingleItemToListbox(DialogModel.lstSelection, Stylename)
+ Else
+ SwitchNumberFormat(ostyle, oFormats, sEuroSign)
+ End If
+ StyleIndex = StyleIndex + 1
+ If StyleIndex &gt; Ubound(StyleRangeAssignMentList()) Then
+ Redim Preserve StyleRangeAssignmentList(StyleIndex)
+ End If
+ StyleRangeAssignmentList(StyleIndex) = &quot;&lt;STYLENAME&gt;&quot; &amp; Stylename &amp; &quot;&lt;/STYLENAME&gt;&quot; &amp; _
+ &quot;&lt;DEFINED&gt;FALSE&lt;/DEFINED&gt;&quot; &amp; &quot;&lt;RANGES&gt;&lt;/RANGES&gt;&quot; &amp;_
+ &quot;&lt;CELLCOUNT&gt;0&lt;/CELLCOUNT&gt;&quot; &amp;_
+ &quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;
+ End If
+ Next m
+ If StyleIndex &gt; -1 Then
+ Redim Preserve StyleRangeAssignmentList(StyleIndex)
+ Else
+ ReDim StyleRangeAssignmentList()
+ End If
+End Sub
+
+
+Sub AssignRangestoStyle(StyleList(), SelList())
+Dim i as Integer
+Dim n as integer
+Dim LastIndex as Integer
+Dim CurStyleName as String
+Dim AssignString as String
+ LastIndex = Ubound(StyleList())
+ StatusValue = 0
+ SetStatusLineText(sStsRELRANGES)
+ For i = 0 To LastIndex
+ CurStyleName = StyleList(i)
+ n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0)
+ AssignString = StyleRangeAssignmentlist(n)
+ If IndexInArray(CurStyleName, SelList()) &lt;&gt; -1 Then
+ &apos; Style is selected
+ If FindPartString(AssignString, &quot;&lt;DEFINED&gt;&quot;, &quot;&lt;/DEFINED&gt;&quot;, 1) = &quot;FALSE&quot; Then
+ AssignString = ReplaceString(AssignString, &quot;&lt;SELECTED&gt;TRUE&lt;/SELECTED&gt;&quot;, &quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;)
+ AssignCellFormatRanges(n, AssignString, CurStyleName)
+ End If
+ Else
+ &apos; Style is not selected
+ If FindPartString(AssignString, &quot;&lt;SELECTED&gt;&quot;, &quot;&lt;/SELECTED&gt;&quot;, 1) = &quot;FALSE&quot; Then
+ DeselectStyle(CurStyleName, n)
+ End If
+ End If
+ IncreaseStatusvalue(SBRELGET/(LastIndex+1))
+ Next i
+End Sub
+
+
+Sub AssignCellFormatRanges(n as Integer, AssignString as String, CurStyleName as String)
+Dim oRanges() as Object
+Dim oRange as Object
+Dim oRangeAddress
+Dim oSheet as Object
+Dim StyleCellCount as Long
+Dim i as Integer
+Dim MaxIndex as Integer
+Dim RangeString as String
+Dim SheetName as String
+Dim RangeName as String
+Dim CellCountString as String
+ StyleCellCount = 0
+ RangeString = &quot;&lt;RANGES&gt;&quot;
+ MaxIndex = oSheets.Count-1
+ For i = 0 To MaxIndex
+ oSheet = oSheets(i)
+ SheetName = oSheet.Name
+ oRanges = osheet.CellFormatRanges.CreateEnumeration
+ While oRanges.hasMoreElements
+ oRange = oRanges.NextElement
+ If oRange.getPropertyState(&quot;NumberFormat&quot;) = 1 Then
+ If oRange.CellStyle = CurStyleName Then
+ oRangeAddress = oRange.RangeAddress
+ RangeName = RetrieveRangeNamefromAddress(oRange)
+ RangeString = RangeString &amp; RangeName &amp; &quot;,&quot;
+ StyleCellCount = StyleCellCount + CountRangeCells(oRange)
+ End If
+ End If
+ Wend
+ Next i
+ If StyleCellCount &gt; 0 Then
+ TotCellCount = TotCellCount + StyleCellCount
+ RangeString = RTrimStr(RangeString,&quot;,&quot;)
+ RangeString = RangeString &amp; &quot;&lt;/RANGES&gt;&quot;
+ CellCountString = &quot;&lt;CELLCOUNT&gt;&quot; &amp; StyleCellCount &amp; &quot;&lt;/CELLCOUNT&quot;
+ AssignString = ReplaceString(AssignString, RangeString,&quot;&lt;RANGES&gt;&lt;/RANGES&gt;&quot;)
+ AssignString = ReplaceString(AssignString, CellCountString,&quot;&lt;CELLCOUNT&gt;0&lt;/CELLCOUNT&gt;&quot;)
+ End If
+ AssignString = ReplaceString(AssignString, &quot;&lt;DEFINED&gt;TRUE&lt;/DEFINED&gt;&quot;, &quot;&lt;DEFINED&gt;FALSE&lt;/DEFINED&gt;&quot;)
+ StyleRangeAssignmentList(n) = AssignString
+End Sub
+
+
+&apos; deletes a styletemplate from the Collection that selects the ranges
+Sub DeselectStyle(DeSelStyleName as String, n as Integer)
+Dim i as Integer
+Dim RangeName as String
+Dim SelectString as String
+Dim AssignString as String
+Dim StyleRangeList() as String
+Dim MaxIndex as Integer
+ SelectString =&quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;
+ AssignString = StyleRangeAssignmentList(n)
+ RangeString = FindPartString(AssignString,&quot;&lt;RANGES&gt;&quot;,&quot;&lt;/RANGES&gt;&quot;,1)
+ StyleRangeList() = ArrayoutofString(RangeString,&quot;,&quot;)
+ MaxIndex = Ubound(StyleRangeList())
+ For i = 0 To MaxIndex
+ RangeName = StyleRangeList(i)
+ If oSelRanges.HasbyName(RangeName) Then
+ oSelRanges.RemovebyName(RangeName)
+ End If
+ Next i
+ AssignString = ReplaceString(AssignString, &quot;&lt;SELECTED&gt;FALSE&lt;/SELECTED&gt;&quot;, &quot;&lt;SELECTED&gt;TRUE&lt;/SELECTED&gt;&quot;)
+ StyleRangeAssignmentList(n) = AssignString
+End Sub
+
+
+Function RetrieveRangeNamefromAddress(oRange as Object) as String
+Dim Rangename as String
+Dim oAddressRanges as Object
+ oAddressRanges = oDocument.createInstance(&quot;com.sun.star.sheet.SheetCellRanges&quot;)
+ oAddressRanges.InsertbyName(&quot;&quot;,oRange)
+ Rangename = oAddressRanges.RangeAddressesasString
+&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
+&apos; oAddressRanges.RemovebyName(RangeName)
+ RetrieveRangeNamefromAddress = Rangename
+End Function
+
+
+&apos; creates a sheet object from an according sectionname
+Function RetrieveSheetoutofRangeName(TableText as String)
+Dim DescriptionList() as String
+Dim SheetName as String
+Dim MaxIndex as integer
+ &apos; find out in which sheet the range is
+ DescriptionList() = ArrayOutofString(TableText,&quot;.&quot;,MaxIndex)
+ SheetName = DescriptionList(0)
+ SheetName = DeleteStr(SheetName,&quot;&apos;&quot;)
+ &apos; set the viewcursor on this sheet
+ RetrieveSheetoutofRangeName = oSheets.GetbyName(SheetName)
+End Function
+
+
+&apos; creates a rangeobject from an according rangename
+Function RetrieveRangeoutofRangeName(TableText as String)
+ oSheet = RetrieveSheetoutofRangeName(TableText)
+ oRange = oSheet.GetCellRangebyName(TableText)
+ RetrieveRangeoutofRangeName = oRange
+End Function
+
+
+Sub ConvertTheSoftWay(StyleList(), bDeSelect as Boolean)
+Dim i as Integer
+Dim l as Integer
+Dim s as Integer
+Dim n as Integer
+Dim CurStyleName as String
+Dim RangeName as String
+Dim OldStatusValue as Integer
+Dim LastIndex as Integer
+Dim oSelListbox as Object
+Dim StyleRangeList() as String
+Dim MaxIndex as Integer
+ oSelListbox = DialogConvert.GetControl(&quot;lstSelection&quot;)
+ LastIndex = Ubound(StyleList())
+ OldStatusValue = StatusValue
+ For i = 0 To LastIndex
+ CurStyleName = StyleList(i)
+ oStyle = oStyles.GetbyName(CurStyleName)
+ StyleRangeList() = GetAssignedRanges(CurStyleName, n)
+ MaxIndex = Ubound(StyleRangeList())
+ For s = 0 To MaxIndex
+ RangeName = StyleRangeList(s)
+ oRange = RetrieveRangeoutofRangeName(RangeName)
+ If oRange.getPropertyState(&quot;NumberFormat&quot;) = 1 Then
+ &apos; Range is hard formatted
+ ConvertCellCurrencies(oRange)
+ CurCellCount = CountRangeCells(oRange)
+ End If
+ IncreaseStatusvalue((CurCellCount/TotCellCount)*(95-OldStatusValue))
+ If bDeSelect Then
+ &apos; Note: On Problems see Bug #73157
+ If oSelRanges.HasbyName(RangeName) Then
+ oSelRanges.RemovebyName(RangeName)
+ oDocument.CurrentController.Select(oSelRanges)
+ End If
+ End If
+ Next s
+ SwitchNumberFormat(ostyle, oFormats, sEuroSign)
+ StyleRangeAssignmentList(n) = &quot;&quot;
+ l = GetItemPos(oSelListBox.Model, CurStyleName)
+ oSelListbox.RemoveItems(l,1)
+ Next
+End Sub
+
+
+Function GetAssignedRanges(CurStyleName as String, n as Integer)
+Dim StyleRangeList() as String
+Dim RangeString as String
+Dim AssignString as String
+ n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0)
+ If n &lt;&gt; -1 Then
+ AssignString = StyleRangeAssignmentList(n)
+ RangeString = FindPartString(AssignString,&quot;&lt;RANGES&gt;&quot;, &quot;&lt;/RANGES&gt;&quot;,1)
+ If RangeString &lt;&gt; &quot;&quot; Then
+ StyleRangeList() = ArrayoutofString(RangeString,&quot;,&quot;)
+ End If
+ End If
+ GetAssignedRanges() = StyleRangeList()
+End Function</script:module> \ No newline at end of file