Quelle  ConvertRun.xba   Sprache: unbekannt

<?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="ConvertRun" script:language="StarBasic">Option Explicit

Public oPreSelRange as Object

Sub Main()
 BasicLibraries.LoadLibrary("Tools")
 If InitResources("Euro Converter") Then
  bDoUnProtect = False
  bPreSelected = True
  oDocument = ThisComponent
  RetrieveDocumentObjects()           ' Statusline, SheetsCollection etc.
  InitializeConverter(oDocument.CharLocale, 1)
  GetPreSelectedRange()
  If GoOn Then
   DialogModel.lstCurrencies.TabIndex = 2
   DialogConvert.GetControl("chkComplete").SetFocus()
   DialogConvert.Execute
  End If
  DialogConvert.Dispose
 End If
End Sub


Sub SelectListItem()
Dim Listbox as Object
Dim oListSheet as Object
Dim CurStyleName as String
Dim oCursheet as Object
Dim oTempRanges as Object
Dim sCurSheetName as String
Dim RangeName as String
Dim oSheetRanges as Object
Dim ListIndex as Integer
Dim a as Integer
Dim i as Integer
Dim n as Integer
Dim m as Integer
Dim MaxIndex as Integer
 Listbox = DialogModel.lstSelection
 If Ubound(Listbox.SelectedItems()) > -1 Then
  EnableStep1DialogControls(False, False, False)
  oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")

  ' Is the sheet the basis, then the sheetobject has to be created
  If DialogModel.optDocRanges.State = 1 Then
   ' Document is the basis for the conversion
   ListIndex = Listbox.SelectedItems(0)
   oCurSheet = RetrieveSheetoutofRangeName(Listbox.StringItemList(ListIndex))
   oDocument.CurrentController.SetActiveSheet(oCurSheet)
  Else
   oCurSheet = oDocument.CurrentController.ActiveSheet
  End If
  sCurSheetName = oCurSheet.Name
  If DialogModel.optCellTemplates.State = 1 Then
   Dim CurIndex as Integer
   For i = 0 To Ubound(Listbox.SelectedItems())
    CurIndex = Listbox.SelectedItems(i)
    CurStylename = Listbox.StringItemList(CurIndex)
    oSheetRanges = oCursheet.CellFormatRanges.createEnumeration
    While oSheetRanges.hasMoreElements
     oRange = oSheetRanges.NextElement
     If oRange.getPropertyState("NumberFormat") = 1 Then
      If oRange.CellStyle = CurStyleName Then
       oSelRanges.InsertbyName("",oRange)
      End If
     End If
    Wend
   Next i
  Else
   ' Hard Formatation is selected
   a = -1
   For n = 0 To Ubound(Listbox.SelectedItems())
    m = Listbox.SelectedItems(n)
    RangeName = Listbox.StringItemList(m)
    oListSheet = RetrieveSheetoutofRangeName(RangeName)
    a = a + 1
    MaxIndex = Ubound(SelRangeList())
    If a > MaxIndex Then
     Redim Preserve SelRangeList(MaxIndex + SBRANGEUBOUND)
    End If
    SelRangeList(a) = RangeName
    If oListSheet.Name = sCurSheetName Then
     oRange = RetrieveRangeoutofRangeName(RangeName)
     oSelRanges.InsertbyName("",oRange)
    End If
   Next n
  End If
  If a > -1 Then
   ReDim Preserve SelRangeList(a)
  Else
   ReDim SelRangeList()
  End If
  oDocument.CurrentController.Select(oSelRanges)
  EnableStep1DialogControls(True, True, True)
 End If
End Sub


' Procedure that is called by an event
Sub RetrieveEnableValue()
Dim EnableValue as Boolean
 EnableValue = Not DialogModel.lstSelection.Enabled
 EnableStep1DialogControls(True, EnableValue, True)
End Sub


Sub EnableStep1DialogControls(bCurrEnabled as Boolean, bFrameEnabled as Boolean, bButtonsEnabled as Boolean)
Dim bCurrIsSelected as Boolean
Dim bObjectIsSelected as Boolean
Dim bConvertWholeDoc as Boolean
Dim bDoEnableFrame as Boolean
 bConvertWholeDoc  = DialogModel.chkComplete.State = 1
 bDoEnableFrame = bFrameEnabled And (NOT bConvertWholeDoc)

 ' Controls around the Selection Listbox
 With DialogModel
  .lblCurrencies.Enabled = bCurrEnabled
  .lstCurrencies.Enabled = bCurrEnabled
  .lstSelection.Enabled = bDoEnableFrame
  .lblSelection.Enabled = bDoEnableFrame
  .hlnSelection.Enabled = bDoEnableFrame
  .optCellTemplates.Enabled = bDoEnableFrame
  .optSheetRanges.Enabled = bDoEnableFrame
  .optDocRanges.Enabled = bDoEnableFrame
  .optSelRange.Enabled = bDoEnableFrame
 End With
 ' The CheckBox has the Value '1' when the Controls in the Frame are disabled
 If bButtonsEnabled Then
  bCurrIsSelected = Ubound(DialogModel.lstCurrencies.SelectedItems()) <> -1
  ' Enable GoOnButton only when Currency is selected
  DialogModel.cmdGoOn.Enabled =  bCurrIsSelected
  DialogModel.chkComplete.Enabled = bCurrIsSelected
  If bDoEnableFrame AND DialogModel.cmdGoOn.Enabled Then
   ' If FrameControls are enabled, check if Listbox is Empty
   bObjectIsSelected = Ubound(DialogModel.lstSelection.SelectedItems()) <> -1
   DialogModel.cmdGoOn.Enabled = bObjectIsSelected
  End If
 Else
  DialogModel.cmdGoOn.Enabled = False
  DialogModel.chkComplete.Enabled = False
 End If
End Sub


Sub ConvertRangesOrStylesOfDocument()
Dim i as Integer
Dim ItemName as String
Dim SelList() as String
Dim oSheetRanges as Object

 bDocHasProtectedSheets = CheckSheetProtection(oSheets)
 If bDocHasProtectedSheets Then
  bDocHasProtectedSheets = UnprotectSheetsWithPassWord(oSheets, bDoUnProtect)
  DialogModel.cmdGoOn.Enabled = False
 End If
 If Not bDocHasProtectedSheets Then
  EnableStep1DialogControls(False, False, False)
  InitializeProgressBar()
  If DialogModel.optSelRange.State = 1 Then
   SelectListItem()
  End If
  SelList() =  DialogConvert.GetControl("lstSelection").SelectedItems()
  If DialogModel.optCellTemplates.State = 1 Then
   ' Option 'Soft' Formatation is selected
   AssignRangestoStyle(DialogModel.lstSelection.StringItemList(), SelList())
   ConverttheSoftWay(SelList(), True)
  ElseIf DialogModel.optSelRange.State = 1 Then
   oSheetRanges = oPreSelRange.CellFormatRanges.createEnumeration
   While oSheetRanges.hasMoreElements
    oRange = oSheetRanges.NextElement
    If CheckFormatType(oRange) Then
     ConvertCellCurrencies(oRange)
     SwitchNumberFormat(oRange, oFormats, sEuroSign)
    End If
   Wend
  Else
   ConverttheHardWay(SelList(), False, True)
  End If
  oStatusline.End
  EnableStep1DialogControls(True, False, True)
  DialogModel.cmdGoOn.Enabled = True
  oDocument.CurrentController.Select(oSelRanges)
 End If
End Sub


Sub ConvertWholeDocument()
Dim s as Integer
 DialogModel.cmdGoOn.Enabled = False
 DialogModel.chkComplete.Enabled = False
 GoOn = ConvertDocument()
 EmptyListbox(DialogModel.lstSelection())
 EnableStep1DialogControls(True, True, True)
End Sub


' Everything previously selected will be deselected
Sub EmptySelection()
Dim RangeName as String
Dim i as Integer
Dim MaxIndex as Integer
Dim EmptySelRangeList() as String

 If Not IsNull(oSelRanges) Then
  If oSelRanges.HasElements Then
   EmptySelRangeList() = ArrayOutofString(oSelRanges.RangeAddressesasString, ";", MaxIndex)
   For i = 0 To MaxIndex
    oSelRanges.RemovebyName(EmptySelRangeList(i))
   Next i
  End If
  oDocument.CurrentController.Select(oSelRanges)
 Else
  oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")
 End If
End Sub


Function AddSelectedRangeToSelRangesEnum() as Object
Dim oLocRange as Object
 osheet = oDocument.CurrentController.GetActiveSheet
 oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges")
 ' Check if a Currency-Range has been selected
 oLocRange = oDocument.CurrentController.Selection
 bPreSelected = oLocRange.SupportsService("com.sun.star.sheet.SheetCellRange")
 If bPreSelected Then
  oSelRanges.InsertbyName("",oLocRange)
  AddSelectedRangeToSelRangesEnum() = oLocRange
 End If
End Function


Sub GetPreSelectedRange()
Dim i as Integer
Dim OldCurrSymbolList(2) as String
Dim OldCurrIndex as Integer
Dim OldCurExtension(2) as String
 oPreSelRange = AddSelectedRangeToSelRangesEnum()
 
 DialogModel.chkComplete.State = Abs(Not(bPreSelected))
 If bPreSelected Then
  DialogModel.optSelRange.State = 1
  AddRangeToListbox(oPreSelRange)
 Else
  DialogModel.optCellTemplates.State  = 1
  CreateStyleEnumeration()
 End If
 EnableStep1DialogControls(True, bPreSelected, True)
 DialogModel.optSelRange.Enabled = bPreSelected
End Sub


Sub AddRangeToListbox(oLocRange as Object)
 EmptyListBox(DialogModel.lstSelection)
 PreName = RetrieveRangeNamefromAddress(oLocRange)
 AddSingleItemToListbox(DialogModel.lstSelection, Prename)', 0)
 SelectListboxItem(DialogModel.lstCurrencies, CurrIndex)
 TotCellCount = CountRangeCells(oLocRange)
End Sub


Sub CheckRangeSelection(Optional oEvent)
 EmptySelection()
 AddRangeToListbox(oPreSelRange)
 oPreSelRange = AddSelectedRangeToSelRangesEnum() 
End Sub


' Checks if a Field (LocField) is already defined in an Array
' Returns 'True' or 'False'
Function FieldInList(LocList(), MaxIndex as integer, ByVal LocField ) As Boolean
Dim i as integer
 LocField = UCase(LocField)
 For i = Lbound(LocList()) to MaxIndex
  If UCase(LocList(i)) = LocField  then
   FieldInList = True
   Exit Function
  End if
 Next
 FieldInList = False
End Function


Function CheckLocale(oLocale) as Boolean
Dim i as Integer
Dim LocCountry as String
Dim LocLanguage as String
 LocCountry = oLocale.Country
 LocLanguage = oLocale.Language
 For i = 0 To 1
  If LocLanguage = LangIDValue(CurrIndex,i,0) AND LocCountry = LangIDValue(CurrIndex,i,1) Then
   CheckLocale = True
   Exit Function
  End If
 Next i
 CheckLocale = False
End Function


Sub SetOptionValuestoNull()
 With DialogModel
  .optCellTemplates.State = 0
  .optSheetRanges.State = 0
  .optDocRanges.State = 0
  .optSelRange.State = 0
 End With
End Sub



Sub SetStatusLineText(sStsREPROTECT as String)
 If Not IsNull(oStatusLine) Then
  oStatusline.SetText(sStsREPROTECT)
 End If
End Sub
</script:module>