OpenOffice.info

Code: Alles auswählen

Sub PFA21DatenpilotLBPName
'---am 28.04.06 für den PFA 2.1a/b angepasst
'---Info für B+P User
'---Kommentare die mit B+P: beginnen, weisen auf Codestellen hin, die durch
'---einen B+P-Nutzer zu ändern sind.
	Dim sTabNameQuelle, sTabNameAusgabe as String
	Dim sFS1, sFS2, sFS3 as string 'Variablen für Felder, die im DP als Seite verwendet werden
	Dim sFZ1, sFZ2, sFZ3 as string 'Variablen für Felder, die im DP als Zeile verwendet werden
	Dim sSp1, sSp2, sSp3 as string 'Variablen für Felder, die im DP als Spalte verwendet werden
	Dim sW1 as string 'Variable für Felder, die im DP berechnet werden
	Dim sW2 as string
	Dim objDatei As object
	Dim objBlattAusgabe, objBlattQuelle, oAktivesBlatt As Object
	Dim objBereich As Object
	Dim oSpalte as Object
	Dim objZiel As New com.sun.star.table.CellAddress'Ausgabe
	Dim objDatenpilotBereich As Object
	Dim objDatenpilotTabellen As Object
	Dim objLayout As Object
	Dim objFelder As Object 'Spaltenkpöfe der Quelltabelle, die in den DP kommen
	Dim objFeld As Object 'konkret über Index angesprochener Spaltenkopf
	Dim i As Integer

	
'---B+P:Name der Quell- und Ausgabetabelle festlegen---	
	sTabNameQuelle = "pfa21_ink_lbp_akt"
	sTabNameAusgabe = "pv_ink_lbp_akt" 


'---B+P:Variablen für den DP belegen---	
	sFS1 = "M_TR_ID,N,16,0" 'Feld für die 1.Seite im DP zuweisen
	sFS2 = "" 'Feld für die 2.Seite im DP zuweisen
	sFZ1 = "M_NUM,C,16" 'Feld für die 1.Zeile im DP zuweisen
	sFZ2 = "M_LEG_ID,C,25" 'Feld für die 2.Zeile im DP zuweisen
	sFZ3 = "" 'Feld für die 3.Zeile im DP zuweisen
	sSp1 = "" 'Feld für die 1.Spalte im DP zuweisen
	sSp2 = "" 'Feld für die 2.Spalte im DP zuweisen
	sSp3 = "" 'Feld für die 3.Spalte im DP zuweisen
	sW1 = "AREA_HA,N,16,2" 'Feld für die 1.Berechnung im DP zuweisen
	sW2 = "WMU_ha_neu" 'Feld für die 2.Berechnung im DP zuweisen
	
	objDatei = 	ThisComponent


	If MsgBox("Folgende Hinweise bitte beachten:"+chr(13)+chr(13)+ _
			"Der Datenpilot greift über den Spaltenname auf die Quelltabelle zu. "+ _
			"Er ist folgendermaßen aufgebaut:"+Chr(13)+ _
			" - Quelltabelle ist "+sTabNameQuelle+chr(13)+ _
			" - Seite(n):-->"+sFS1+", "+sFS2+chr(13)+ _
			" - Zeile(n):-->"+sFZ1+" "+sFZ2+" "+sFZ3+chr(13)+ _
			" - Spalte(n):-->"+sSp1+", "+sSp2+chr(13)+ _
			" - Berechnung der Felder:-->"+sW1+", "+sW2+chr(13)+chr(13)+ _
			"Der Filter kann mehr als drei Kriterien haben. Diese sind im Basic-Code "+ _
			"in der Variable objFilter des Makros PFA21DatenpilotLBPName definiert."+chr(13)+chr(13)+ _
			"Bereits bestehende Datenpiloten werden gelöscht. Wollen Sie fortfahren?" _
			,4,"Datenpilot im 1.Blatt neu erzeugen?")= 7 then
		exit sub
	End If	
	
'---Bildschirmaktualisierung wird ausgeschaltet---	
	objDatei.lockControllers()


'---prüft, ob das Blatt Daten, das hier die Quelldaten hat, vorhanden ist---
	If objDatei.Sheets.hasByName(sTabNameQuelle) = False Then
		MsgBox ("Das Blatt "+sTabNameQuelle+" mit den notwendigen GIS-Quelldaten"+chr(13)+ "ist nicht vorhanden." _
		,"Datenpilot-Info")
		Exit Sub
	End If
	objBlattQuelle = objDatei.Sheets().getByName(sTabNameQuelle)
	objBereich = objBlattQuelle.getCellRangeByName("A2:BD10000")'Quelldaten festlegen
	objBlattAusgabe = objDatei.sheets(0)

	
'---legt den Ausgabebereich des DP fest---
	With objZiel
		.Sheet = 0
		.Row = 4
		.Column = 0
	End With	

'---ruft den DP-Assistent auf und legt das Layout fest
	objDatenpilotTabellen = objBlattAusgabe.getDataPilotTables()
	objLayout = objDatenpilotTabellen.createDataPilotDescriptor()
	with objLayout
		.setSourceRange(objBereich.getRangeAddress())'Datenquelle zuweisen
		.ShowFilterButton = "false" 'Filter ein- oder ausschalten
		'.RowGrand = "True"
	end with
'---DATENPILOT DEFINIEREN-->FILTERKIRTTERIEN-----------------------------------------------------
	Dim objFilter(1) as New com.sun.star.sheet.TableFilterField'Array für bis zu 3 Filterkriterien
''---B+P:definiert das 1. von 3 Filterkriterien--
	objFilter(0).Field = 6
	objFilter(0).IsNumeric = False
	objFilter(0).OPERATOR = com.sun.star.sheet.FilterOperator.EQUAL
	objFilter(0).StringValue = "A"

'---B+P:definiert das 2. von 3 Filterkriterien--
	objFilter(1).CONNECTION = com.sun.star.sheet.FilterConnection.OR 'oder-Verknüpfung zu Filter 1
	objFilter(1).Field = 6
	objFilter(1).IsNumeric = False
	objFilter(1).OPERATOR = com.sun.star.sheet.FilterOperator.EQUAL
	objFilter(1).StringValue = "E"

'---B+P:definiert das 3. Filterkriterium--
'	objFilter(2).CONNECTION = com.sun.star.sheet.FilterConnection.OR 'und-Verknüpfung zu Filter 1
'	objFilter(2).Field = 37
'	objFilter(2).IsNumeric = False
'	objFilter(2).OPERATOR = com.sun.star.sheet.FilterOperator.EQUAL
'	objFilter(2).StringValue = "rein 2"
	

'---B+P:definiert das 4.Filterkriterium--
'	objFilter(3).CONNECTION = com.sun.star.sheet.FilterConnection.OR 'oder-Verknüpfung zu Filter 1
'	objFilter(3).Field = 37
'	objFilter(3).IsNumeric = False
'	objFilter(3).OPERATOR = com.sun.star.sheet.FilterOperator.EQUAL
'	objFilter(3).StringValue = "rein 1"
	
'---übergibt die Filterdefinitionen als Array---	
	objLayout.FilterDescriptor.setFilterFields(objFilter())

'---
	objFelder = objLayout.getDataPilotFields()

'---DATENPILOT DEFINIEREN-->1.SEITE IM DP------------------------------------------
'---einzelne Spaltenköpfe und ihren Anordung als Zeile im DP werden ausgewählt---
'	objFeld = objFelder.getByName(sFS1)
	objFeld = objFelder.getByIndex(13)
	objFeld.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.PAGE
	
'---DATENPILOT DEFINIEREN-->2.SEITE IM DP------------------------------------------
'---einzelne Spaltenköpfe und ihren Anordung als Zeile im DP werden ausgewählt---
'	objFeld = objFelder.getByName(sFS2)
'	objFeld.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.PAGE

'---DATENPILOT DEFINIEREN-->ZEILEN BZW. LINKE SEITE IM DP------------------------------------------
'---definiert Feld, das die 1. Zeile im DP ist---
'	objFeld = objFelder.getByName(sFZ1)
	objFeld = objFelder.getByIndex(13)
	objFeld.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.ROW

''---definiert Feld, das die 2. Zeile im DP ist---
'	objFeld = objFelder.getByName(sFZ2)
'	objFeld.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.ROW

''---definiert Feld, das die 3. Zeile im DP ist---
'	objFeld = objFelder.getByName(sFZ3)
'	objFeld.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.ROW
	
'---definiert Feld, das 1.Spaltenkopf im DP ist---	
'	objFeld = objFelder.getByName(sSp1)
'	objFeld.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.COLUMN

'---definiertFeld, das 2.Spaltenkopf im DP ist---	
'	objFeld = objFelder.getByName(sSp2)
'	objFeld.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.COLUMN

''---definiert 3.Spaltenkopf im DP---	
'	objFeld = objFelder.getByName(sSp3)
'	objFeld.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.COLUMN

'---DATENPILOT DEFINIEREN-->ART DER BERECHNUNG IM DP---------------------------------------------
'---Felder, die im DP berechnet werden---
	objFeld = objFelder.getByName(sW1)
	objFeld.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.DATA
	objFeld.Function = com.sun.star.sheet.GeneralFunction.SUM'Summenfunktion
'	objFeld.Function = com.sun.star.sheet.GeneralFunction.COUNT'Anzahl

	objFeld = objFelder.getByName(sW2)
	objFeld.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.DATA
	objFeld.Function = com.sun.star.sheet.GeneralFunction.SUM'Summenfunktion
'	objFeld.Function = com.sun.star.sheet.GeneralFunction.COUNT'Anzahl

'---Frage nach dem dem Blatt sTabNameAusgabe, ggf. löschen und neu anlegen---
	objBlattAusgabe=objDatei.sheets(0)
	objDatenPilotTabellen = objBlattAusgabe.getDataPilotTables()
		If objDatenpilotTabellen.hasByName(sTabNameAusgabe)=true Then 
			objDatenpilotTabellen.removeByName(sTabNameAusgabe) 
		End If
		
'---das Ergebnis wird bei an das obZiel übergeben---
	objDatenpilotTabellen.insertNewByName(sTabNameAusgabe, objZiel, objLayout)
	

'---Spaltenbreite auf definierte Werte einstellen
	oAktivesBlatt = objDatei.getCurrentController.activeSheet
	for I = 1 to 4 'Spalten 2 bis 5 werden festgelegt
		oSpalte = oAktivesBlatt.columns(I)
		oSpalte.isTextWrapped = true 'Umbruch in der Zelle
		oSpalte.ParaIsHyphenation = true 'Silbentrennung in der Zelle
	next I
		oSpalte = oAktivesBlatt.columns(2)
		oSpalte.Width = "4800"
		oSpalte = oAktivesBlatt.columns(3)
		oSpalte.Width = "1500"

'---Bildschirmaktualisierung wird ausgeschaltet---	
	objDatei.unlockControllers()	
End Sub