Doppelte Fußnoten per Makro löschen - Wie Seitenzahlen ermitteln

Programmierung unter AOO/LO (StarBasic, Python, Java, ...)

Moderator: Moderatoren

georg3200
Beiträge: 5
Registriert: Di, 22.04.2008 13:20

Doppelte Fußnoten per Makro löschen - Wie Seitenzahlen ermitteln

Beitrag von georg3200 » Mo, 05.08.2019 14:17

Hi, bin neu bei OpenOffice und soll ein Makro schreiben, welches doppelte Fußnoten löscht.
Bisher kann ich auf die Fußnoten eines Dokumentes zugreifen. Aber wie ermittele ich zu einer Fußnote die Seite auf welcher sie sich befindet?

Dim oFootnotesHere
document = ThisComponent
'Hier kommt ne Schleife zum iterieren
oFootnotesHere = document.Footnotes(0)

Über oFootnotesHere.Label und oFootnotesHere.String komme ich an den Inhalt.

Aber wie komme ich zur Seitenzahl auf welcher diese Fußnote steht. Ich müsste quasi von der Fußnote nach oben zum Page-Objekt (so es denn so etwas gibt hier) und von da zur Seitenzahl.

Sorry für die Newbie-Fragen. Ist alles noch Neuland für mich.

Stephan
********
Beiträge: 11123
Registriert: Mi, 30.06.2004 19:36
Wohnort: nahe Berlin

Re: Doppelte Fußnoten per Makro löschen - Wie Seitenzahlen ermitteln

Beitrag von Stephan » Mo, 05.08.2019 14:58

Du musst den sog. View-Cursor auf den Ankerpunkt der Fußnote setzen und dann die Seitennummer des View-Cursors auslesen:

Code: Alles auswählen

	v_cur = document.CurrentController.viewCursor
	
	'...
	oFootnotesHere = document.Footnotes(0)
	
	v_cur.GotoRange(oFootnotesHere.Anchor, False)
	
	Msgbox "Aktuelle Fußnote auf Seite: " & v_cur.Page
	'...
Falls Du die Ursprungsposition des View-Cursors erhalten musst, musst Du Dir diese merken indem Du den View-Cursor an einen Textcursor übergibst und am Ende den Textcursor wieder an den View-Cursor. Infos hier:
http://www.dannenhoefer.de/faqstarbasic ... ml#cursor2


Gruß
Stephan

Benutzeravatar
Faol
****
Beiträge: 125
Registriert: Di, 26.01.2016 21:18

Re: Doppelte Fußnoten per Makro löschen - Wie Seitenzahlen ermitteln

Beitrag von Faol » Mo, 05.08.2019 15:01

Hallo Georg,

hier ein Makro von mir, dass ich mit Hilfe dieses Forums optimiert habe.
Es listet alle im Dokument vorkommenden Fußnoten, dazugehörige Seitenzahl, etc. in einer Calc-Tabelle auf.

Code: Alles auswählen

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

REM *********************************  BASIC  ***************************************
REM *																				*
REM *	Auflistung aller im Dokument vorhandenen Fussnoten in einer Calc-Tabelle	*
REM *																				*
REM *********************************************************************************
Sub FussnotenExport
Dim oDocC as Object
Dim oDocW as Object
Dim oSheet as Object
Dim oRange as Object
Dim oAnchor as Object

Dim sPath as String
Dim mArr() as Variant
Dim oCol as Object
Dim i as Long

   	' Hier in der Basic-IDE -> Objektkatalog
	' LibreOffice Makros & Dialoge -> Tools
	If NOT GlobalScope.BasicLibraries.isLibraryLoaded( "Tools" ) Then
	   GlobalScope.BasicLibraries.LoadLibrary( "Tools" )
	End I
	' Referenz: aktuelles Dokument
    oDocW = ThisComponent

REM ----------------------------------------------------------------------------------------
REM Errorhandling: Fokus
    ' Prüfung: Ist das aktuelle Dokument ein Writer-Dokument? 
    ' Wenn nicht, dann Programm nach Meldung beenden.
    If getDocType(oDocW) = "unknown" then 
    	 MsgBox "Das aktuelle Dokument ist kein Writer-Dokument!" & chr(10) &_
    				"Bitte öffnen Sie das gewünschte Writer-Dokument, stellen den Cursor" & chr(10) &_
    					"in eine der Zeilen und starten das Makro erneut." & chr(10) &_
	    					"Das Programm wird beendet.", 48, "Fehler: Dokument oder Applikation unbekannt!"
			' Programm beenden
			Exit Sub
    End If 

    ' Prüfung: Ist das aktuelle Dokument ein Writer-Dokument? 
    ' Wenn nicht, dann Programm nach Meldung beenden.
	If NOT oDocW.supportsService("com.sun.star.text.TextDocument") Then
    	MsgBox "Das aktuelle Dokument ist kein Writer-Dokument!" & chr(10) &_
    				"Bitte öffnen Sie das gewünschte Writer-Dokument, stellen den Cursor" & chr(10) &_
    					"in eine der Zeilen und starten das Makro erneut." & chr(10) &_
	    					"Das Programm wird beendet.", 48, "Fehler: Kein Writer-Dokument"
			' Programm beenden
			Exit Sub	
	End If

'    mri oDocW
    ' URL des aktuellen Dokuments ermitteln
    sPath=oDocW.Location
    ' URL in Pfadangabe wandeln
    sPath=convertfromURL(sPath)
    ' Prüfung: Wurde das Dokument schon mal gespeichert?
    ' Wenn nicht, dann Programm nach Meldung beenden.
    If sPath = "" Then 
    	MsgBox "Das Writer-Dokument wurde noch nicht gespeichert!" & chr(10) &_
					"Bitte speichern Sie das Dokument und starten das Makro erneut." & chr(10) &_    	
   						"Das Programm wird beendet.", 32, "Dokument muss zuvor gespeichert werden!"
			' Programm beenden
			Exit Sub
	End If		

REM ----------------------------------------------------------------------------------------
	oCC=oDocW.CurrentController
		oVC = oCC.getViewCursor
	
    ' Referenz: Fußnoten-Objekt
    oFN=oDocW.Footnotes
    mri oDocw
    ' Prüfung: Sind Fußnoten im Dokument enthalten?
    ' Wenn nicht, dann Programm nach Meldung beenden.
    If oFN.Count = 0 Then 
    	MsgBox "Im Writer-Dokument sind keine Fußnoten enthalten!" & chr(10) &_
   					"Das Programm wird beendet.", 32, "Keine Fußnoten!"
			' Programm beenden
			Exit Sub
	End If		

    oFNSettings = oDocW.getFootnoteSettings()
    'Öffnen eines Calc-Dokuments
    oDocC = StarDesktop.loadComponentFromURL("private:factory/scalc","_blank", 0, Array())
    'Referenzierung der "Tabelle 1"
    oSheet = oDocC.Sheets(0)
'mri oDocC
'mri oSheet
	' Tabellenblatt formatieren
	With oSheet
        .Name="Fußnotenliste" 
        .CharFontName="Times New Roman"
        .CharHeight=10       
	End With

REM ----------------------------------------------------------------------------------------------
REM Seite skalieren
 s = oDocC.CurrentController.getActiveSheet().PageStyle
  oStyle = oDocC.StyleFamilies.getByName("PageStyles").getByName(s)
  oStyle.PageScale = 75		' ---> 85%

	StyleFamilies = oDocC.StyleFamilies
	PageStyles = StyleFamilies.getByName("PageStyles")
		DefPage = PageStyles.getByName("Default")
'mri defpage	
REM ----------------------------------------------------------------------------------------------
REM Seite formatieren
		With Defpage
REM................................................
REM Querformat
'			.IsLandscape = True
'			.Width = 29700
'			.Height = 21000
'			.TopMargin=1000
'			.BottomMargin=500
'			.LeftMargin=500
'			.RightMargin=500
REM............................................
REM Hochformat
			.IsLandscape = False
			.Width = 21000
			.Height = 29700
			.TopMargin=1000
			.BottomMargin=500
			.LeftMargin=1500
			.RightMargin=500
REM............................................			
			.HeaderIsOn=True
			.HeaderIsShared = True
			.CenterHorizontally=True
			.CenterVertically=False
'			.PageScale=75
		End With
'mri oFN(1)
    'Zellbereich A:C zwecks Dimensionierung des Array's in das Array schreiben
    mArr()=osheet.getcellrangebyposition(0,1,3,oFN.Count).getDataArray
    
REM ----------------------------------------------------------------------------------------
REM Fussnoten auslesen
	For i = 0 To oFN.Count-1

			' Spalte A 
			mArr(i)(0) = oFN(i).Anchor.String
'			mri oFN(i)
			' Spalte C
			mArr(i)(2) = oFN(i).String
			' Spalte D
			oAnchor=oFN(i).anchor
			If isempty(oAnchor.cell) Then
				'im normalen Text
				oTxt=oAnchor.text
			Else
				'in einer Tabellenzelle
				oTxt=oAnchor.cell
			End If
			ocur=otxt.createtextcursorbyrange(oAnchor)
			ocur.collapsetostart
			ocur.gotostartofparagraph(true)
			mArr(i)(3) = ocur.string
			
			' Spalte B
			' Zwecks Ermittlung der Seitenzahl, auf der sich die aktuelle Fußnote befindet,
			' wird der Textcursor an den Viewcursor übergeben. 
			' Grund: Der Textcursor verfügt nicht über die Methode	"getPage()"
			oVC.gotoRange(ocur,false)
						mArr(i)(1) = oVC.getPage()
	Next i

REM ----------------------------------------------------------------------------------------
REM Referenz Range-Objekt (Zellbereich)
    oRange = osheet.getcellrangebyposition(0,1,3,oFN.Count)   
	with oRange
	    'Array in Zellbereich schreiben
		.setDataArray(mArr)
		
	End With
    'Spaltenüberschrift einfügen und formatieren
	With oSheet
        .getCellRangeByName("A1").String="Index"
        .getCellRangeByName("B1").String="Seite"
        .getCellRangeByName("C1").String="Fussnoten"
        .getCellRangeByName("D1").String="Absatz: Inhalt"
        .getCellRangeByName("A1").CharWeight = com.sun.star.awt.FontWeight.BOLD        
        .getCellRangeByName("B1").CharWeight = com.sun.star.awt.FontWeight.BOLD
        .getCellRangeByName("C1").CharWeight = com.sun.star.awt.FontWeight.BOLD
        .getCellRangeByName("D1").CharWeight = com.sun.star.awt.FontWeight.BOLD
        .getCellRangeByName("A1").HoriJustify=com.sun.star.table.CellHoriJustify.CENTER
		.getCellRangeByName("B1").HoriJustify=com.sun.star.table.CellHoriJustify.CENTER
		.getCellRangeByName("C1").HoriJustify=com.sun.star.table.CellHoriJustify.CENTER
		.getCellRangeByName("D1").HoriJustify=com.sun.star.table.CellHoriJustify.CENTER
        .getCellRangeByName("A1").charcolor = &H000000
        .getCellRangeByName("B1").charcolor = &H000000 
        .getCellRangeByName("C1").charcolor = &H000000
        .getCellRangeByName("D1").charcolor = &H000000
    End With
    'Spaltenbreite anpassen
    oCol = oSheet.getColumns()
	' Text in Zelle vertikal zentrieren
	oRange.VertJustify= 2
	
	'Spalte A formatieren
	oColA = oCol.getbyname("A")
	oColA.VertJustify= 2
	oColA.HoriJustify=com.sun.star.table.CellHoriJustify.CENTER

	'Spalte B formatieren
	oColB = oCol.getbyname("B")
	oColB.VertJustify= 2
	oColB.HoriJustify=com.sun.star.table.CellHoriJustify.CENTER

	' optimale Zellbreite
    oCol.optimalWidth = true
	' Refrenz Spalte "C"
    oColC = oCol.getbyname("C")
	' Spaltenbreite 8,0cm
'    oColC.Width=8000
	' Spaltenbreite 5,5cm
    oColC.Width=5500
    ' Zeilenumbruch einstellen
    oColC.IsTextWrapped= True

    ' Refrenz Spalte "D"
    oColD = oCol.getbyname("D")
	' Spaltenbreite 20,5cm
'    oColD.Width=20500
	' Spaltenbreite 15,0cm
    oColD.Width=15000
    ' Zeilenumbruch einstellen
    oColD.IsTextWrapped= True
' Zellumrandung zeichnen
dim linestyle as new com.sun.star.table.BorderLine
	linestyle.Color = RGB(0, 0, 0)
	linestyle.OuterLineWidth = 40
	borders = array("TopBorder", "LeftBorder", "RightBorder", "BottomBorder")
	styles = array(linestyle,linestyle,linestyle,linestyle)
		oRange.setPropertyValues(borders , styles)
	
' Zeile 1 = Wiederholungszeile
Dim oRange2 as object
Dim CellRangeAddress as Object

	oRange2 = oSheet.getCellRangeByPosition(0,0,3,0)
	CellRangeAddress = oRange2.getRangeAddress()

		oSheet.setTitleRows(CellRangeAddress)

REM ----------------------------------------------------------------------------------------
REM >>> Inhalt Kopfzeile zuweisen <<<
HContent = defpage.RightPageHeaderContent 

' Kopfzeile zentriert
HText = HContent.CenterText
HText.setString("Fußnotenliste")
'mri Htext

' rechte Seite
defpage.rightPageHeaderContent = HContent
' linke Seite
defpage.LeftPageHeaderContent=HContent


REM ----------------------------------------------------------------------------------------
REM >>> Inhalt Fußzeile zuweisen <<<
FContent = defpage.RightPageFooterContent 

'Fußzeile links >>> Datei- und Pfadangabe
'HText = FContent.LeftText
'HText.setstring(sPath)

'Fußzeile zentriert >>> leer
HText = FContent.CenterText
HText.setstring("")

'Fußzeile rechts >>> Seitenzahl
HText = FContent.RightText
oField = oDocC.createInstance("com.sun.star.text.TextField.PageNumber")
oCursor = HText.createTextCursor()
HText.insertTextContent(oCursor, oField, False)

' rechte Seite
defpage.rightPageFooterContent = FContent
' linke Seite
defpage.LeftPageFooterContent=FContent 

'mri defpage
'	Defpage.PageScale=85

End Sub

REM ----------------------------------------------------------------------------------------
REM Funktion prüft welche Applikation den Fokus hat
Function getDocType(Optional vDoc) As String
  On Error GoTo Oops
  If IsMissing(vDoc) Then vDoc = ThisComponent
  If vDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
    getDocType = "Calc"
  ElseIf vDoc.SupportsService("com.sun.star.text.TextDocument") Then
    getDocType = "Writer"
  ElseIf vDoc.SupportsService("com.sun.star.drawing.DrawingDocument") Then
    getDocType = "Draw"
  ElseIf vDoc.SupportsService(_
                     "com.sun.star.presentation.PresentationDocuments") Then
    getDocType = "Presentation"
  ElseIf vDoc.SupportsService("com.sun.star.formula.FormulaProperties") Then
    getDocType = "Math"
  ElseIf vDoc.SupportsService("com.sun.star.sdb.OfficeDatabaseDocument") Then
    getDocType = "Base"
  Else
    getDocType = "unknown"
  End If
Oops:
  If Err <> 0 Then getDocType = "unknown"
  On Error GoTo 0   'Turn off error handling AFTER checking for an error
End Function
Gruß
Faol
⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒
Win.10 Prof. (x64) • AOO 4.1.6 • LibO 6.2.3.2 (x64)
⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐⇐

georg3200
Beiträge: 5
Registriert: Di, 22.04.2008 13:20

Re: Doppelte Fußnoten per Makro löschen - Wie Seitenzahlen ermitteln

Beitrag von georg3200 » Mo, 05.08.2019 15:44

Hallo ihr beiden,
Danke Euch für den Stups in die offenbar richtige Richtung. Ich probiere mein Glück mit Euren Beispielen :)

Grüße
Georg

Antworten