libreoffice-canzeley-client 0.5.0-2 / usr / lib / libreoffice / share / extensions / canzeley-client / Kanzleiprogramm / FoBerMod1.xba

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="FoBerMod1" script:language="StarBasic">REM                        *****  BASIC  *****
REM        	              ***** Canzeley *****
REM              Copyright (C) 2008, 2009 Dr. Michael Stehmann
REM                  info@rechtsanwalt-stehmann.de
REM This program is free software: you can redistribute it and/or modify it
REM under the terms of the GNU General Public License as published by the
REM Free Software Foundation, either version 3 of the License, or any later version.
REM This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
REM without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
REM See the GNU General Public License for more details.
REM You should have received a copy of the GNU General Public License along with this program.
REM If not, see &lt;http://www.gnu.org/licenses/&gt;.
REM                      *** Version 0.5.0 ***

REM **** Kanzleiprogramm - FoBerMod1****

Option Explicit

Private sZusatz As String
Private sPfadUndDatei As String
Private iFoBerFrom As Integer
Private iPruef As Integer


Sub ForderungsberechnungMit

Dim iNoAuswahl As Integer

	iFoBerFrom = 1 : iNoAuswahl = 0
	
AktenAnsMod1.GerichtAuswahlPruefen(iNoAuswahl)

	If iNoAuswahl = 1 Then Exit Sub

AktenAnsMod1.GerichtStringBilden
AktenAnsMod1.GeschaeftszeichenUndRubrumErmitteln
Forderungsberechnung	

End Sub


Sub ForderungsberechnungOhne

	iFoBerFrom = 0
Forderungsberechnung

End Sub


Sub Forderungsberechnung

	iPruef = 0

DocPfadFoBer
FilenameFoBerBilden

	If iPruef = 1 Then Exit Sub
	
VorlageFoBerLaden

	If iPruef = 1 Then Exit Sub
	
DatenEinfuegen	
FoBerDokumentSpeichern

End Sub


REM ** Pfad zur Vorlage und Url bilden, Vorlage laden **
Sub VorlageFoBerLaden

Dim aArgs(0) As New com.sun.star.beans.PropertyValue

FSMod.Vorlagenpfad

	sUrl =  ConvertToURL(sVorlagenPfad+&quot;Sonstiges/Forderungsberechnung367.ots&quot;)
	
	If FileExists(sUrl) Then
			
		aArgs(0).Name = &quot;MacroExecutionMode&quot;
		aArgs(0).Value = com.sun.star.document.MacroExecMode.ALWAYS_EXECUTE_NO_WARN
		
		oDoc = StarDesktop.loadComponentFromURL(sUrl, &quot;_blank&quot;, 0, aArgs())
		
	Else
	
		iPruef = 1
		MsgBox (&quot;Vorlage Forderungsberechnung367.ots existiert nicht!&quot;, 16, &quot;Leider:&quot;)
	
	End If	
	
End Sub


Sub DatenEinfuegen

Dim oSheet As Object
Dim oSheets As Object
Dim oCell As Object
Dim sTabName As String
Dim iBindestrich As Integer
Dim iSheet As Integer

REM *Druckbereichshack *
Dim oPrintRange As new com.sun.star.table.CellRangeAddress
Dim oTitleRange As new com.sun.star.table.CellRangeAddress
Dim aPrintRanges(0)

	sTabName = sRegisterNr
	iBindestrich = InStr(sTabName, &quot;-&quot;)
	Mid(sTabName, iBindestrich, 1, &quot;_&quot;)

	oSheets = oDoc.getSheets()
	
	REM * Tabellenblatt loeschen *
	oSheets.removeByName(&quot;Copyright&quot;)
	
	REM * Tabellenblatt umbenennen *
	iSheet = oSheets.getCount()
	oSheets.copyByName(&quot;Forderung&quot;, sTabName, iSheet)
	oSheets.removeByName(&quot;Forderung&quot;)
	
	oSheet = oDoc.Sheets.getByName(sTabName)
	
REM * Druckbereichshack s. Issue 105170 *

	With oPrintRange
		.startColumn = 2
		.endColumn = 14
		.startRow = 0
		.endRow = 65000
	End With
	
	aPrintRanges(0) = oPrintRange

	With oTitleRange
		.startRow = 8
		.endRow = 9
	End With	
	
	With oSheet
		.setPrintAreas(aPrintRanges)
		.setTitleRows(oTitleRange)
	End With
	
REM * Ende Druckbereichshack *		

	If iFoBerFrom = 1 Then
	
		REM * Gerichsdaten einfuegen *
		oCell = oSheet.getCellRangebyName(&quot;D5&quot;)
		oCell.String = sGericht
		
		oCell = oSheet.getCellRangebyName(&quot;L5&quot;)
		oCell.String = sGeschaeftszeichen
		
	Else

		REM * Gerichtsfelder leeren *
		oCell = oSheet.getCellRangebyName(&quot;C5&quot;)
		oCell.String = &quot;&quot;
		
		oCell = oSheet.getCellRangebyName(&quot;G5&quot;)
		oCell.String = &quot;&quot;
		
		oCell = oSheet.getCellRangebyName(&quot;J5&quot;)
		oCell.String = &quot;&quot;
		
	End If
	
End Sub


Sub DocPfadFoBer

	sPfadUndDatei = sVuDPfad+&quot;Dokumente/&quot;+sRegisterNr+&quot;/Forderungsberechnung.ods&quot;

End Sub


Sub FilenameFoBerBilden

Dim iAntwort As Integer
Dim iAntwortZ As Integer
Dim aArgs(0) As New com.sun.star.beans.PropertyValue

	If FileExists(sPfadUndDatei) Then
	
		iAntwort = MsgBox(&quot;Wollen Sie eine neue Forderungsberechnungsdatei anlegen?&quot;, 3+32, &quot;Datei &quot;+sPfadUndDatei+&quot; existiert bereits!&quot;)

		Select Case iAntwort
	
			Case 2			REM &quot;Abbrechen&quot;
				iPruef = 1
			Case 6			REM &quot;Ja&quot;
				iAntwortZ = MsgBox(&quot;Wollen Sie die Datei &quot;+sPfadUndDatei+&quot; überschreiben?&quot;, 4+32, &quot;Noch eine Frage:&quot;)
				If iAntwortZ = 7 Then NeueDatei			REM &quot;Nein&quot;
			
			Case 7			REM &quot;Nein&quot;
				iPruef = 1
				sPfadUndDatei = ConvertToURL(sPfadUndDatei)
				aArgs(0).Name = &quot;MacroExecutionMode&quot;
				aArgs(0).Value = com.sun.star.document.MacroExecMode.ALWAYS_EXECUTE_NO_WARN
				oDoc = StarDesktop.loadComponentFromURL(sPfadUndDatei, &quot;_blank&quot;, 0, aArgs())
			
		End Select

	End If
	
End Sub


Sub NeueDatei

Dim sZusatzAlt As String
Dim sZusatz As String

	sZusatzAlt = sZusatz
	
	sZusatz = InputBox(&quot;Bitte Zusatz eingeben:&quot;, &quot;Datei &quot;+sPfadUndDatei+&quot; existiert bereits.&quot;)
		
REM * Sonderzeichen in sZusatz umwandeln *
FSMod.ZeichenUmwandlung (sZusatz)
	
	sZusatz = sZusatzAlt+sZusatz
	
	sPfadUndDatei = sVuDPfad+&quot;Dokumente/&quot;+sRegisterNr+&quot;/Forderungsberechnung&quot;+sZusatz+&quot;.ods&quot;
		
FilenameFoBerBilden

End Sub


Sub FoBerDokumentSpeichern

Dim sUrl As String
Dim anoArgs()
Dim sChown As String
Dim sChmod As String

On Local Error Goto Fehler

REM * Wenn Automount = Ja, dann Test durchführen *
	iMountTest = 0

	If iOs = 4  And iAutoMount = 1 Then
	FSMod.Mounttest
	Else
		iMountTest = 1
	End If
	
	If iMountTest = 1 Then

REM * URL bilden *	

		sUrl =  ConvertToURL(sPfadUndDatei)

REM * Speichern *
		oDoc.storeAsURL(sUrl, anoArgs())
	
REM * Gruppe der Datei auf &quot;canzeley&quot; setzen und Rechte aendern *
REM * - nur bei unixoiden Systemen *
		If iOs = 4 Then
	
			sChown = &quot;:canzeley &quot;+sPfadUndDatei
			Shell(&quot;chown&quot;,0,sChown,True)
	
			sChmod = &quot;g+w,o-r &quot;+sPfadUndDatei
			Shell(&quot;chmod&quot;,0,sChmod,True)
		
		End If
		
	Else
		MsgBox (&quot;Datei &quot;+sPfadUndDatei+&quot; kann nicht gespeichert werden!&quot;,16,&quot;Mounttest fehlgeschlagen!&quot;)
	End If

Exit Sub
Fehler:
	MsgBox (&quot;Datei kann nicht gespeichert werden!&quot;,16,&quot;Es ist ein Fehler aufgetreten:&quot;)
				
End Sub
</script:module>