libreoffice-canzeley-client 0.5.0-2 / usr / lib / libreoffice / share / extensions / canzeley-client / Kanzleiprogramm / HerkunftMod1.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="HerkunftMod1" script:language="StarBasic">REM                        *****  BASIC  *****
REM        	              ***** Canzeley *****
REM              Copyright (C) 2009, 2010 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 - HerkunftMod1 ****

Option Explicit

Private sAuswertung As String
Private aHerkunft(0,2)
Private aHerkunftOhne(0,2)
Private oDoc As Object
Private oSheet As Object
Private oCell As Object


Sub HerkunftAuswerten

	sAuswertung	=&quot;Herkunft&quot;

SQLMod.HerkunftMod1Abfrage1
BezeichnungsArrayBilden

End Sub


Sub SachbearbeiterAuswerten

	sAuswertung	=&quot;Sachbearbeiter&quot;

SQLMod.HerkunftMod1Abfrage3
BezeichnungsArrayBilden

End Sub


Sub SachgebietAuswerten

	sAuswertung	=&quot;Sachgebiet&quot;

SQLMod.HerkunftMod1Abfrage5
BezeichnungsArrayBilden

End Sub


REM ** Array der IDs und Bezeichnungen bilden **
Sub BezeichnungsArrayBilden

	i=0
	While (oResultSet.next)

		ReDIM Preserve aHerkunft(i,2)
			aHerkunft(i,0) = CStr(oResultSet.getInt(1))
			aHerkunft(i,1) = oResultSet.getString(2)
		i = i+1
	Wend
	    
DiaMod1.HerkunftDia (sAuswertung)

End Sub


Sub HerkunftsdatenErmitteln (sAnfangsdatum As String, sEnddatum As String)

Dim iReihenZahl As Integer
Dim iZwischen As Integer

	iZwischen = 0
	
	For i = LBound(aHerkunft) To UBound(aHerkunft)
	
		sHerkunft = aHerkunft(i,0)
		
		Select Case sAuswertung
		
			Case &quot;Herkunft&quot;
			SQLMod.HerkunftMod1Abfrage2 (sAnfangsdatum, sEnddatum)
			Case &quot;Sachbearbeiter&quot;
			SQLMod.HerkunftMod1Abfrage4 (sAnfangsdatum, sEnddatum)
			Case &quot;Sachgebiet&quot;
 			SQLMod.HerkunftMod1Abfrage6 (sAnfangsdatum, sEnddatum)
 			Case Else
 			SQLMod.HerkunftMod1Abfrage2 (sAnfangsdatum, sEnddatum)
 			
 		End Select
 		
 		While (oResultSet.next)
 		
			aHerkunft(i,2) = oResultSet.getInt(1)
				
			If  aHerkunft(i,2) &gt; 0 Then
				ReDIM Preserve aHerkunftOhne(iZwischen,2)
				aHerkunftOhne(iZwischen,0) = aHerkunft(i,0)	
 				aHerkunftOhne(iZwischen,1) = aHerkunft(i,1)
 				aHerkunftOhne(iZwischen,2) = aHerkunft(i,2)
 				iZwischen = iZwischen+1
 			End If
 		
		Wend
 	
 	Next i
 	
 	iReihenZahl = UBound(aHerkunftOhne)
	
NeueTabelle
WerteEingeben (sAnfangsdatum, sEnddatum)
DiagrammErzeugen (iReihenZahl)
FeinMachen

End Sub


Sub NeueTabelle

Dim anoArgs()
Dim sUrl As String
Dim oSheets As Object
Dim iSheet As Integer

	sUrl = &quot;private:factory/scalc&quot;
	oDoc = StarDesktop.loadComponentFromURL(sUrl, &quot;_blank&quot;, 0, anoArgs())
	
	REM * Tabellenblatt umbenennen *
	oSheets = oDoc.getSheets()
	iSheet = oSheets.getCount()
	oSheets.copyByName(&quot;Tabelle1&quot;, sAuswertung, iSheet)
	oSheets.removeByName(&quot;Tabelle1&quot;)
	oSheets.removeByName(&quot;Tabelle2&quot;)
	oSheets.removeByName(&quot;Tabelle3&quot;)

End Sub


Sub WerteEingeben (sAnfangsdatum As String, sEnddatum As String)

Dim sBeginn As String
Dim sEnde As String
Dim oSpalteA As Object

	sBeginn = SQLMod.DatumDB2Prog (Mid(sAnfangsdatum, 2, 10))
	sEnde = SQLMod.DatumDB2Prog	(Mid(sEnddatum, 2, 10))

	oSheet = oDoc.Sheets.getByName(sAuswertung)
	
	oSpalteA = oSheet.Columns(0)
	oSpalteA.IsTextWrapped = True
		
	oCell = oSheet.getCellRangebyName(&quot;B1&quot;)
	oCell.CharWeight = com.sun.star.awt.FontWeight.BOLD
	oCell.String = sAuswertung+&quot; der Fälle vom &quot; + sBeginn + &quot; bis &quot;+ sEnde
	
	oCell = oSheet.getCellRangebyName(&quot;A3&quot;)
	oCell.CharWeight = com.sun.star.awt.FontWeight.BOLD
	oCell.String = sAuswertung
	
	oCell = oSheet.getCellRangebyName(&quot;B3&quot;)
	oCell.CharWeight = com.sun.star.awt.FontWeight.BOLD
	oCell.String = &quot;Anzahl&quot;
	
	For i = LBound(aHerkunftOhne) To UBound(aHerkunftOhne)
	
		oCell = oSheet.getCellRangebyName(&quot;A&quot;+CStr(i+4))
		oCell.String = aHerkunftOhne(i,1)
		oCell.ParaIsHyphenation = True
						
		oCell = oSheet.getCellRangebyName(&quot;B&quot;+CStr(i+4))
		oCell.Value = aHerkunftOhne(i,2)
		
	Next i
	
	oCell = oSheet.getCellRangebyName(&quot;A&quot;+CStr(i+5))
	oCell.String = &quot;Insgesamt:&quot;
	oCell.CharWeight = com.sun.star.awt.FontWeight.BOLD
	
	oCell = oSheet.getCellRangebyName(&quot;B&quot;+CStr(i+5))
	oCell.Formula = &quot;=SUM(B4:B&quot;+CStr(i+4)+&quot;)&quot;
	oCell.CharWeight = com.sun.star.awt.FontWeight.BOLD
		
End Sub


Sub DiagrammErzeugen (iReihenZahl As Integer)

Dim oCDia As Object
Dim oCDeo As Object
Dim oCDiaFlaeche As New com.sun.star.awt.Rectangle
Dim oCellAddress(0) As New com.sun.star.table.CellRangeAddress

	oCDia = oSheet.Charts
	
	oCDiaFlaeche.X = 8000
	oCDiaFlaeche.Y = 2000
	oCDiaFlaeche.Width = 15100
	oCDiaFlaeche.Height = 15100
	
	oCellAddress(0).Sheet = 0
	oCellAddress(0).StartColumn = 0
	oCellAddress(0).StartRow = 2
	oCellAddress(0).EndColumn = 1
	oCellAddress(0).EndRow = iReihenZahl+3
	
	oCDia.addNewByName (&quot;HerkunftDia&quot;, oCDiaFlaeche, oCellAddress(), True, True)

REM * Tortendiagramm *	
	oCDeo = oCDia.getByName(&quot;HerkunftDia&quot;).embeddedObject
	oCDeo.Diagram = oCDeo.createInstance(&quot;com.sun.star.chart.PieDiagram&quot;)
	
REM * Alternatives Balkendiagramm *	
REM	oCDeo.Diagram = oCDeo.createInstance(&quot;com.sun.star.chart.BarDiagram&quot;)
REM	oCDeo.Diagram.YAxis.Min = 0
REM	oCDeo.Diagram.YAxis.AutoMax = True
REM	oCDeo.Diagram.XAxis.TextRotation = 4500	

End Sub


Sub FeinMachen

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

REM *Header und Footer*
Dim oStyleFamilies As Object 
Dim oPageStyles As Object
Dim oDefPage As Object
Dim oFooter As Object

REM *Landscape*
Dim aPP()


REM * Druckbereich festlegen *

	With oPrintRange
		.startColumn = 0
		.endColumn = 12
		.startRow = 0
		.endRow = 27
	End With
	
	aPrintRanges(0) = oPrintRange

	With oSheet
		.setPrintAreas(aPrintRanges)
	End With

REM *Header und Footer*	
	oStyleFamilies = oDoc.StyleFamilies
	oPageStyles = oStyleFamilies.getByName(&quot;PageStyles&quot;)
	oDefPage = oPageStyles.getByName(&quot;Default&quot;)

	oDefPage.HeaderIsOn = False
	
	oDefPage.FooterIsOn = True
	oDefPage.FooterIsShared = True
	oFooter = oDefPage.rightPageFooterContent
	oFooter.CenterText.String = &quot;Canzeley - Das Freie Kanzleiprogramm&quot;
	oDefPage.rightPageFooterContent = oFooter
	
REM *Auf Landscape umstellen*
	aPP = oDoc.getPrinter()
	aPP(1).value = 1
	oDoc.setPrinter(aPP)
	
End Sub

</script:module>