REM  *****  BASIC  *****



'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 02.10.2003
'Die Funktion gibt das erste Auftreten eines Strings in einem Array von Strings zurück.
Function GetItemPosFromArray(sList() as string, sItem as String)
Dim ItemList()
Dim MaxIndex as Integer
Dim i as Integer
	MaxIndex = Ubound(sList())	
	For i = 0 To MaxIndex
		If sItem = ItemList(i) Then
			GetItemPosFromArray() = i
			Exit Function
		End If
	Next i
	GetItemPosFromArray() = -1
End Function




'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 28.10.2003
'Erweiterte Funktion aus den Originalmakros (Tools - Misc)
'Die Funktion giebt den Dokumententyp des gewählten Dokumentes zurück. 
Function GetDocType(oDocument)
' Erweiterte Funktion aus den Originalmakros (Tools - Misc)
	On Local Error GoTo NODOCUMENTTYPE
	If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
		GetDocType() = "scalc"
	ElseIf oDocument.SupportsService("com.sun.star.text.TextDocument") Then
		GetDocType() = "swriter"
	ElseIf oDocument.SupportsService("com.sun.star.drawing.DrawingDocument") and _
	   oDocument.SupportsService("com.sun.star.presentation.PresentationDocument")=False Then
		GetDocType() = "sdraw"
	ElseIf oDocument.SupportsService("com.sun.star.formula.FormulaProperties") Then
		GetDocumentType() = "smath"
	ElseIf oDocument.SupportsService("com.sun.star.presentation.PresentationDocument") Then	
   		GetDocType() = "simpress"
    End If
	NODOCUMENTTYPE:
	If Err <> 0 Then
		GetDocumentType = ""
		Resume GOON
		GOON:
	End If
End Function

'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 19.11.2003
' Die Prozedure liest alle geöffnet URL-Pfade aus.
' Zur Zeit werden neue Dateien "Unbenannt" nicht erkannt
' Der Aufruf erfolgt über 
'    dim listall(1)
'    listofallurls(listall())
sub ListOfAllUrls(ListOfUrl())
	'Variablendeklaration
    Dim oComponents as Object
    Dim oDocs as Object
    Dim oDoc as Object    
    Dim i as integer
    Dim j as integer
    Dim k as integer
    'Aufruf des Desktops
    oComponents = StarDesktop.getComponents()
    oDocs = oComponents.createEnumeration()
    'Anzahl der offenen Fenster auslesen
    i=0  
    Do While oDocs.hasMoreElements()
	 	oDoc = oDocs.nextElement()
        i=i+1
    Loop
    'Neudimensionierung des arrays
    redim ListOfUrl(i)
    'Audruf der Unterfunktion
    ListOfAllDocs(ListOfUrl())
      'Anzahl der wirkliche Urls auslesen 
    j=0
    for k=0 to i
      if ListOfUrl(k)<>"" then j=j+1
    next
    'Neudimensionierung
    Dim TempList(j)
    l=0
    for k=0 to j
     if ListOfUrl(k)<>"" then 
       TempList(l)=ListOfUrl(k)
       l=l+1
     end if
    next   
    redim ListOfUrl(j)
    ListOfUrl()=TempList()
end sub

'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 19.11.2003
'Wird von ListOfAllUrls benötigt
sub ListOfAllDocs(ListAllDocs())
    Dim oComponents as Object
    Dim oDocs as Object
    Dim oDoc as Object    
    Dim i as integer
	oComponents = StarDesktop.getComponents()
	oDocs = oComponents.createEnumeration()
    i=0
	Do While oDocs.hasMoreElements()
		oDoc = oDocs.nextElement()
		on error goto nextelement
            ListAllDocs(i)=odoc.url
            i=i+1
		nextelement:		
	Loop
end sub



'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 12.10.2003
'Liest die Position des aktiven Sheets aus. Daran denken das die Zählung bei 0 anfängt.
Function GetPosActiveSheet(oDoc as object) as Integer
   Dim MyName as String
   Dim ListOfSheets(1)
   Dim i as Integer
   MyName=odoc.currentcontroller.activesheet.name
   GetNameOfAllSheets(ListOfSheets(),oDoc)
   For i=0 to ubound(ListOfSheets())
    if ListOfSheets(i)=MyName then GetPosActiveSheet=i
   Next 
end Function


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 12.10.2003
'Die Prozedur gibt ein array mit den Namen der Sheets zurück
' Der Aufruf erfolgt über 
'    dim listall(1)
'    GetNameOfAllSheets(listall(),odoc)
Sub GetNameOfAllSheets(NameOfSheets(),oDoc as Object)
    Dim oSheets as Object
    Dim oSheet as Object
    Dim i as integer
    Dim iAnzahl as integer
    oSheets=odoc.sheets
    Anzahl = oSheets.count
    Anzahl = Anzahl - 1
    Redim NameOfSheets(Anzahl)
    For i = 0 to Anzahl
       oSheet = oDoc.Sheets(i)
       NameOfSheets(i)=oSheet.name
    Next
End Sub    
       
'Version: 08.12.2003
'Aktiviert das ausgewählte Sheet nach dem Namen.    
Sub JumpToSheetsName( myDoc as Objekt, sheetsname as String)
	myView = myDoc.CurrentController
	mySheet = myDoc.Sheets.getByName(sheetsname)
	myView.setActiveSheet(mySheet) 
End Sub



'Version: 08.12.2003
'Aktiviert das ausgewählte Sheet nach dem Index

Sub JumpToSheetsNumber( myDoc as Objekt, sheetsnumber as String)
	myView = myDoc.CurrentController
	mySheet = myDoc.Sheets(sheetsnumber)
	myView.setActiveSheet(mySheet) 
End Sub    
    
'Version: 09.04.2004
'Setzt die gewünschte Seitenvorlage fest
Sub SetDocPageStyle(odoc as object,strNew as String)
  Dim oCursor As Object
  MyCursor = odoc.Text.createTextCursor()
  MyCursor.PageDescName = strNew
End Sub	


'Version: 09.04.2004
'Springt mit dem sichtbaren Cursor an eine Textmarke
Sub MoveCursorToBookmark(oDoc as Objekt, strBookmark as String)
 oViewCursor = oDoc.CurrentController.getviewCursor()
 oBookmark = oDoc.Bookmarks.getByName(strBookmark)
 oBookmarkAnchor = oBookmark.Anchor
 oViewCursor.gotorange(oBookmarkAnchor,false) 
End Sub

'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 09.05.2004
'Kopiert die angebene Bilbliothek von der geöffneten Datei in die Standard Bibliothek
'Dies ist die Routine zu addLibaries, damit sowohl die Dialoge wie auch die Module kopiert werden.

sub addLib(oGlobalLib as object, oLib as object, quelle_lib as string, ziel_lib as string)
    	Dim oquell_Lib As Object
    	Dim oZiel_Lib As Object
    	Dim Zaehler As Integer
     	Dim quellModules() as string

    	If oGlobalLib.hasByName(ziel_lib) = False Then
			oGlobalLib.createLibrary( ziel_lib )
        End If
		  	oquell_Lib = oLib.getByName(quelle_lib)
			quellModules = oquell_Lib.getElementNames()

		If oLib.hasByName(quelle_lib) Then
		  	oquell_Lib = oLib.getByName(quelle_lib)
			quellModules = oquell_Lib.getElementNames()
			for Zaehler=0 to ubound( quellModules()) 
				oZiel_Lib = oGlobalLib.getByName(ziel_lib)
				
				If oZiel_Lib.hasByName( quellModules(zaehler) ) = False Then
					oZiel_Lib.insertByName( quellModules(zaehler),oquell_Lib.getByName( quellModules(zaehler)))
				End If
			Next Zaehler
		End If		
end sub	


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 09.05.2004
'Aufruf addLibraries("Bibliothek","Bibliothek")
'Kopiert die angebene Bilbliothek von der geöffneten Datei in die Standard Bibliothek
'
Sub addLibraries(quell_LibName as String, ziel_LibName as String)
    Dim oLibrary As Object
	Dim oGlobalLibrary As Object

'   Erst die mal die Module
	oGlobalLibrary = GlobalScope.BasicLibraries
	oLibrary = BasicLibraries
    addLib(oGlobalLibrary, oLibrary, quell_libname,ziel_libname)
'   Dann die Dialoge
	oLibrary = DialogLibraries
	oGlobalLibrary = GlobalScope.DialogLibraries
    addLib(oGlobalLibrary, oLibrary, quell_libname,ziel_libname)
End Sub


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 09.05.2004
'Aufruf removeLibraries( "Bibliothek")
'Löscht die angebene Bibliothek. Module und Dialoge


Sub removeLibraries(Libname as String)
    oGlobalLibrary = GlobalScope.DialogLibraries
	If oGlobalLibrary.hasByName( Libname ) Then
		oGlobalLibrary.removeLibrary( Libname )
	End If

	oGlobalLibrary = GlobalScope.BasicLibraries
	If oGlobalLibrary.hasByName( Libname ) Then
		oGlobalLibrary.removeLibrary( Libname )
	End If
End Sub


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 09.05.2004
'Liest die aktuelle Zeile und Spalte aus.
'Achtung der Index beginnt bei 0. Erste Zeile 0
function getRow as integer
       oDoc=thisComponent
    	If oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
       oCelle=oDoc.getCurrentSelection().getCellAddress()
       getRow=oCelle.Row
       end if
end function

function getColumn as integer
       oDoc=thisComponent
    	If oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
       oCelle=oDoc.getCurrentSelection().getCellAddress()
       getColumn=oCelle.column
       end if 
end function

'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 01.06.2004
'Ändert den Wert einer Variablen und aktualisiert die Ansicht
Sub ChangeVariable(oDocument as object,Variable,NewContent as String)
  Dim Var as String
  Dim oTextfieldMaster As Object
  Dim oPropSet as Object
  Dim oDependentTextFields as Object
  Dim oXDependentTextField as Object
  Dim oTextFields as Object
  On Error Resume Next
  Var ="com.sun.star.text.FieldMaster.SetExpression."+Variable
  oTextfieldMasters = oDocument.getTextFieldMasters()
  oPropSet = oTextfieldMasters.getByName(Var)
  oDependentTextFields = oPropSet.DependentTextFields
  oXDependentTextField = oDependentTextFields(0)
  oldValue = oXDependentTextField.Content
  oXDependentTextField.setPropertyValue("Content", Newcontent)  
  oTextFields = oDocument.getTextFields()
  oTextFields.refresh()
  On Error Goto 0
End Sub


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 01.06.2004
'Liest den Wert einer Variablen eines Textdokumentes aus.
Function GetVariable(oDocument as object,Variable) as string
  Dim Var as String
  Dim oTextfieldMaster As Object
  Dim oPropSet as Object
  Dim oDependentTextFields as Object
  Dim oXDependentTextField as Object
  Dim oTextFields as Object
  On Error Resume Next
  Var ="com.sun.star.text.FieldMaster.SetExpression."+Variable
  oTextfieldMasters = oDocument.getTextFieldMasters()
  oPropSet = oTextfieldMasters.getByName(Var)
  oDependentTextFields = oPropSet.DependentTextFields
  oXDependentTextField = oDependentTextFields(0)
  GetVariable= oXDependentTextField.Content
  On Error Goto 0
End Function

'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 01.06.2004
'Ändert den Wert eines Benutzerfeldes und aktualisert die Ansicht.
sub ChangeUserField (oDocument as Object,StrUserField as String, StrContent as String)
	Dim oDocu as Object
    Dim oTextFieldMasters as Object
    Dim TxtUserfield as String
	On Error Resume Next
    oTextFieldMasters = oDocument.TextFieldMasters
    TxtUserfield="com.sun.star.text.FieldMaster.User."+StrUserfield
    oTextFieldMasters.getByName(TxtUserfield).content = StrContent
    On Error Goto 0
    oTextFields = oDocument.getTextFields()
    oTextFields.refresh()
End Sub     

'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 01.06.2004
'Liest den Wertes eines Benutzerfeldes aus.
Function GetUserField (oDocument as Object,StrUserField as String) as string
	Dim oDocu as Object
    Dim oTextFieldMasters as Object
    Dim TxtUserfield as String
	On Error Resume Next
    oTextFieldMasters = oDocument.TextFieldMasters
    TxtUserfield="com.sun.star.text.FieldMaster.User."+StrUserfield
    GetUserField=oTextFieldMasters.getByName(TxtUserfield).content
    On Error Goto 0
End Function     


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Version: 01.06.2004
'Ändert den Wert des Benutzerfeldes in den Eigenschaften des Dokumentes.
'Die Funktion liset den Wert aus.
'Ist natürlich nur ein Einzeile, pass als eigene Routine besser zu den Routinen ChangeVariable und ChangeUserField.
Sub ChangeDocUserField(odocument as object, x as integer, newt as string)
   oDocument.DocumentInfo.setUserFieldValue(x ,newt)
End Sub		

Function GetDocUserField(odocument as object,x  as integer) as string
  GetDocUserField= oDocument.DocumentInfo.getUserFieldValue(x)
End Function	


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 07.07.2004
'Stellt den Schutzstatus einer Calc-Zelle ein. Achtung die Tabelle selber darf nicht geschützt sein.

sub Zellschutz(myCell as Object, gesperrt as boolean, formelhidden as boolean,ausblenden as boolean,druck as boolean)
   Dim myProtection As New com.sun.star.util.CellProtection
   myProtection.IsLocked=gesperrt
   myProtection.IsFormulaHidden=formelhidden
   myProtection.IsHidden=ausblenden
   myProtection.IsPrintHidden=druck
   myCell.CellProtection=myProtection
end sub

'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 19.11.2004
'Übergibt den aktuellen Tabellennamen in Calc. Kann auch in einer Zelle ( =Tabellenname() ) verwendet werden.

Function TabellenName as String
  odoc=stardesktop.currentcomponent
  Tabellenname=odoc.currentcontroller.activesheet.name
end Function



'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 19.11.2004
'Mit dieser Funktion kann man den sichtbaren Cursor an den leistungsfähigeren nichtsichtbaren Cursor übergeben.
Function GetCursor( oDoc As Object ) As Object
' Übernahme des sichtbaren Cursors in eine TextRangeobject

     Dim oRange As Object, oRangeCursor As Object
     
     oRange = oDoc.CurrentController.Selection.getbyIndex(0)
     oRangeCursor = oDoc.Text.createTextCursorByRange( oRange )
     GetCursor = oRangeCursor

End Function 


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 19.11.2004
'Setzt einen nichtsichtbaren Cursor auf den sichtbaren Cursor.

Sub SetViewCursor ( oDoc as object, oCursor as object)

  oViewCursor = oDoc.CurrentController.getviewCursor()
  oViewCursor.gotorange(oCursor,false) 

end Sub


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 06.12.2004
'Liest alle vorhandenen Datenbank in ein array.

Function GetListAllDatabases(ListofAllDatabases())
  Dim AllDatabases As Object
  Dim NameofDB 
  Dim i As Integer
  DatabaseContext = createUnoService("com.sun.star.sdb.DatabaseContext")
  NameofDB = DatabaseContext.getElementNames()
  ' Zählen der Databases. 
  For I = 0 To UBound(NameofDB())
  Next I
  Redim ListofAllDatabases(i-1)
  For i = 0 To UBound(NameofDB())
    ListofAllDatabases(i)=NameofDB(i)
  Next I
end Function


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 23.01.2005
'Setzt aus einer Inputbox einen neunen Autor als Ersteller.


sub SetNeuerAutor
  oDoc=thiscomponent
  nautor=inputbox("Bitte geben Sie den Autor ein","Neuer Autor")
  oDoc.DocumentInfo.Author=nautor 
end sub


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 26.02.2005
'Mit dieser Funktion kann gezielt ein geöffnetses Fenster als doc-Object aufgerufen werden.
'Voraussetzung ist das der Name bekannt ist.
'Ist das Fenster nicht vorhanden wird das aktuelle übergeben.
function fensterwaehlen(dateiname as string) as object
  GlobalScope.BasicLibraries.LoadLibrary("Tools")
  Dim oDesktop As Object, oDocs As Object
  Dim oDoc As Object, oComponents As Object
  gefunden=false
  oComponents = StarDesktop.getComponents()
  oDocs = oComponents.createEnumeration()
  Do While oDocs.hasMoreElements()
    oDoc = oDocs.nextElement()
    On Error Goto Weiter
    datei=odoc.geturl()
    FileN=FileNameoutofPath(datei)
    if FileN=dateiname then 
       fensterwaehlen=odoc
       gefunden=true
      end if 
    weiter:
  Loop
  if gefunden=false then fensterwaehlen=stardesktop.currentcomponent
end Function



'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 26.03.2005
'Diese Routine setzt den aktuellen Cursor von allen Sheets auf eine bestimmte Zelle.

sub AllSheetsA1 (myDoc as Object, row as integer,col as integer)
   'Anzahl der Sheets auslesen
   Anzahl=myDoc.Sheets.count
   mySheet = myDoc.Sheets(0)
   'Sichtbaren Cursor holen
   myView = myDoc.CurrentController
   'schleife über die Sheets
   for i=0 to anzahl-1 
      mySheet = myDoc.Sheets(i)
      mycell =  mysheet.getCellByPosition(row,col)
      myView.setActiveSheet(mysheet) 
      mydoc.CurrentController.Select(mycell)
   next i
   'erstes Sheet aktiveren
   mySheet = myDoc.Sheets(0)
   myView.setActiveSheet(mysheet) 
end sub


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 03.04.2005
'Funktion um eine Nummer aus einer Datei zu lesen und die Nummer danach automatisch hochzustetzen.
'Der Dateiname muß angepaßt werden und der erste Werte muß von Hand erzeugt werden.

function GetAndSetNumber as string
 dim f as Integer
 dim rechnungsdatei as string
  dim renummer as string
  rechnungsdatei="c:/re.txt"
  if FileExists("file:///"&rechnungsdatei) then
    f = FreeFile()
    Open "file:///"&rechnungsdatei for Input as #f
    Line Input #f, renummer
    close #f
    f = FreeFile()
    Open "file:///"&rechnungsdatei for output as #f
    Print #f, val(renummer)+1
    close #f
   else
    renummer=0
  endif
 GetAndSetNumber=renummer
end function


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 19.04.2005
'Zwei Routinen die man mit einem Tastaturbefehl verknüpfen kann, um dann zwischen den Absätze zu springen.

sub gotoNextParagraph
   Dim myDoc as Object
   Dim myViewCursor as Object
   Dim myTextCursor as object
   myDoc=thisComponent
   myViewCursor=myDoc.GetCurrentController.ViewCursor
   mytextCursor=mydoc.text.createtextcursor()
   mytextCursor.gotoRange(myViewCursor,false)
   mytextCursor.gotoNextParagraph(false)
   mytextCursor.gotoStartOfParagraph(false)
   myViewCursor.gotoRange(myTextCursor,false)   
end sub

sub gotoPreviousParagraph
   Dim myDoc as Object
   Dim myViewCursor as Object
   Dim myTextCursor as object
   myDoc=thisComponent
   myViewCursor=myDoc.GetCurrentController.ViewCursor
   mytextCursor=mydoc.text.createtextcursor()
   mytextCursor.gotoRange(myViewCursor,false)
   mytextCursor.gotoPreviousParagraph(false)
   mytextCursor.gotoStartOfParagraph(false)
   myViewCursor.gotoRange(myTextCursor,false)   
end sub

'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 28.04.2005
'Liest die Gesamtanzahlseiten aus einem WriterDokument.


function getpages as string
   myDoc = thiscomponent
   myViewCursor=myDoc.GetCurrentController.ViewCursor
   myTempCursor=myViewCursor
   myViewCursor.jumpToLastPage
   getpages=myViewCursor.getPage()
   myViewCursor.gotoRange(myTempCursor,false)
end function  


'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 05.05.2005
'Liest zu einer gewüschten Eigenschaften eines Proprtyarrays (com.sun.star.beans.Propertyvalue) den Wert und Index aus. Zusätzlich wir der Name mit zurückgegeben.
'Der Rückgabewert ist ein Array mit drei Elementen.

function GetPropertyValandInd(aProperty as array,propName as string)
  Dim Ergeb(2) as string
  for i=0 to ubound(aProperty())
    if aProperty(i).name = propName then
       Ergeb(0)=propName
       Ergeb(1)=aProperty(i).value
       Ergeb(2)=i
     end if
    next
    GetPropertyValueAndIndex()=Ergeb()
end function       

'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 20.05.2005
'Liest die vorhandenen Absätze aus dem Writerdokument. Mit dem Paramater ignoreEmpty werden leere Absätze ingoriert.

function getParagraphs(odoc as object, optional ignoreEmpty as boolean)

	Dim myEnum as object
    Dim isAbsatz as boolean
    Dim myAbsatz as object
    Dim i as Integer	
    if IsMissing(ignoreEmpty) then
      ignoreEmpty = false
    end if
    msgbox ignoreEmpty

    'Auslesen der Anzahl
    i=0
	myEnum = oDoc.Text.createEnumeration
    While myEnum.hasMoreElements
    		myAbsatz = myEnum.nextElement
            isAbsatz=hasunointerfaces(myAbsatz,"com.sun.star.text.XTextRange")
            if isAbsatz then
               if ignoreEmpty then    
                    if myAbsatz.string<>"" then
                       i=i+1
                    end if
                 else
                 i=i+1
               end if      
            end if
     Wend

    Redim allParagraphs(i)   

	'Auslesen der Absätze
	i=0
	myEnum = oDoc.Text.createEnumeration
	While myEnum.hasMoreElements
    		myAbsatz = myEnum.nextElement
            isAbsatz=hasunointerfaces(myAbsatz,"com.sun.star.text.XTextRange")
            if isAbsatz then
              if ignoreEmpty then    
                    if myAbsatz.string<>"" then
                      allParagraphs(i)=myAbsatz
                      i=i+1
                    end if
                 else
                 allParagraphs(i)=myAbsatz
                 i=i+1
               end if      
            end if
        Wend
    getParagraphs()=allParagraphs()    
end function



'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 25.05.2005
'Die Funktion liefert die Anzahl der Textteile eines Absatzes zurück. 
'Jeder Textteil steht für eine eigene Formatierung.
'Ist der Rückgabewert 1, besteht der Absatz nur aus einer Formartierung.

function hasParagraphFormat( oPara as object) as integer
  Dim enumTextTeile as object
  Dim i as integer
  Dim Dummy as object
  i=0
       enumTextTeile=oPara.createEnumeration
            while  enumTextTeile.hasMoreElements
    	 		Dummy = enumTextTeile.nextElement
                i=i+1
            wend  
  hasParagraphFormat=i           
end function

'Autor: Michael Dannenhöfer
'mail: starbasic@dannenhoefer.de
'Datum: 28.05.2005
'Die Funktion liest den Wert zu einem durch sName bestimten Property aus
'Als Unterstützung zum debuggen kann man sich auch einen Wert übergeben lassen wenn der Eintrag nicht vorhanden ist.


Function getProperty( arProps, sName As String, Optional debug as Boolean ) 
   For i = LBound( arProps ) To uBound( arProps )
      checkProp = arProps(i)
      If checkProp.Name = sName Then
         getProperty() = checkProp.value
         Exit Function
      EndIf
   Next
   getProperty()=""
   if debug then getProperty()="Die Propertie mit dem Namen: "+sName+" ist nicht vorhanden"
End Function