BITTE helfen Sie uns HEUTE mit einer SPENDE
Helfen Sie das LibreOffice Forum zu erhalten!

❤️ DANKE >><< DANKE ❤️

> KEINE WERBUNG FÜR REGISTRIERTE BENUTZER!<
Ihre Spende wird für die Deckung der laufenden Kosten sowie den Erhalt und Ausbau 🌱 des LibreOffice Forums verwendet.
🤗 Als Dankeschön werden Sie im Forum als LO-SUPPORTER gekennzeichnet. 🤗

[gelöst] [Writer] Absatzumbruch (¶) ersetzen

Alles zur Programmierung im LibreOffice.
tmp
Beiträge: 13
Registriert: Sa 27. Aug 2022, 12:41

Re: [Writer] Absatzumbruch (¶) ersetzen

Beitrag von tmp » Sa 10. Sep 2022, 13:02

Ich habe mal noch etwas herumprobiert. Solange sich die Ausführung in der While-Schleife befindet, ist ein Löschen der Zeile mit dem Cursor nicht möglich. Außerhalb der While-Schleife funktioniert es.

Daher habe ich den Code wie folgt abgwandelt:

Code: Alles auswählen

Option VbaSupport 1
Option Explicit
'===========================================
Sub remove_empty_paragraphs

Dim Doc As Object
Dim Enum1 As Object
Dim Enum2 As Object
Dim TextElement As Object
Dim TextPortion As Object
Dim ViewCursor As Object
Dim TextCursor As Object
Dim Document   As Object
Dim Dispatcher As Object
Dim i As Integer, j As Integer, k As Integer
Dim a As Variant

Doc = ThisComponent
Enum1 = Doc.Text.createEnumeration()
ViewCursor = ThisComponent.getCurrentController().getViewCursor()
Document = Doc.CurrentController.Frame
Dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

Call replace_whitespaces

i = 0 'counts the paragraphs
j = 0 'counts the sub-paragraphs; used for debugging
k = 0 'counts the empty paragraphs; if k > 1, the paragraph will be deleted; if a paragraph is not empty, k will be resetted to 0
ReDim a(0)

'loop over all paragraphs
While Enum1.hasMoreElements
	TextElement = Enum1.nextElement
	ViewCursor.gotoRange(TextElement, false)
	i = i + 1
	ReDim Preserve a(i)
	a(i) = 0
	If TextElement.supportsService("com.sun.star.text.Paragraph") Then
		Enum2 = TextElement.createEnumeration
		'loop over all sub-paragraphs
		Do While Enum2.hasMoreElements
			TextPortion = Enum2.nextElement
			j = j + 1
			If TextPortion.String = "" Then
				If TextPortion.BreakType = 0 Then 'no break
					k = k + 1
				ElseIf TextPortion.BreakType = 4 Then 'break before
					k = 0
					a(i - 1) = 0
					Exit Do
				ElseIf TextPortion.BreakType = 5 Then 'break after
					k = 0
					Exit Do
				End If
			Else
				k = 0
				Exit do
			End If
		Loop
		If k >= 2 Then
			a(i) = 1
		End If
		j = 0
	End If
Wend
TextCursor = Doc.getText().createTextCursor()
For i = 1 to UBound(a)
	If a(i) = 1 Then
		Dispatcher.executeDispatch(Document, ".uno:Delete", "", 0, Array())
		'Call delete_paragraph
	Else
		TextCursor.gotoNextParagraph(false)
		ViewCursor.gotoRange(TextCursor, false)
	End if
Next i

End Sub
'===========================================
Sub replace_whitespaces

Dim Doc As Object
Dim Replace As Object

Doc = ThisComponent
Replace = Doc.createReplaceDescriptor
Replace.SearchRegularExpression = True
Replace.SearchString = "^\s*$"
Replace.ReplaceString = ""
Doc.replaceAll(Replace)

End Sub
Damit wird aus diesem Text...:

(An dieser Position ist ein Bild eingefügt, das im Hintergrund liegt. Der Text ist also über dem Bild.)


Lorem ipsum¶
Lorem ipsum dolor sit amet, consectetur adipisici elit, sed eiusmod tempor incidunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquid ex ea commodi consequat.¶



Quis aute iure reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur.¶




Excepteur sint obcaecat cupiditat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.¶


(An dieser Position befindet sich ein Seitenumbruch)


...jetzt dieser Text:


(An dieser Position ist ein Bild eingefügt, das im Hintergrund liegt.)
Lorem ipsum¶
Lorem ipsum dolor sit amet, consectetur adipisici elit, sed eiusmod tempor incidunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquid ex ea commodi consequat.¶

Quis aute iure reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur.¶

Excepteur sint obcaecat cupiditat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.¶

(An dieser Position befindet sich ein Seitenumbruch)


Damit kann ich leben. :-)

Ich danke euch für eure Hilfe.

musikai
Beiträge: 262
Registriert: Do 14. Mai 2015, 17:53

Re: [gelöst] [Writer] Absatzumbruch (¶) ersetzen

Beitrag von musikai » Sa 10. Sep 2022, 18:09

Wunderbar,

hätte hier noch einen Ansatz zum Ausbauen gehabt:

Code: Alles auswählen

rem lösche leere Zeilen, die kein bild oder umbruch haben
Sub delete_empty_paras
Call replace_whitespaces
oText = ThisComponent.Text
oTextEnumeration = oText.createEnumeration

    do while oTextEnumeration.hasmoreelements
        oPar = oTextEnumeration.nextelement
        If len(oPar.getString()) = 0 and pic_or_break(oPar)= 0 then
        oPar.dispose()
        end if
    loop

End Sub

function pic_or_break (oPar)
pic_or_break=0

If oPar.supportsService("com.sun.star.text.Paragraph") Then
		TextEnum = oPar.createEnumeration
	
		Do While TextEnum.hasMoreElements
			TextPortion = TextEnum.nextElement
				If TextPortion.BreakType <> 0 or TextPortion.TextPortionType="Frame" Then
					pic_or_break=1
				end if
		Loop
End If
end function

'===========================================
Sub replace_whitespaces

Dim Doc As Object
Dim Replace As Object

Doc = ThisComponent
Replace = Doc.createReplaceDescriptor
Replace.SearchRegularExpression = True
Replace.SearchString = "^\s*$"
Replace.ReplaceString = ""
Doc.replaceAll(Replace)

End Sub

Zuletzt geändert von musikai am So 11. Sep 2022, 19:37, insgesamt 3-mal geändert.
Win7 Pro, Sibelius 7.1.3, Lubuntu 15.10, LibO 4.4.7, OO 4.1.3
Free Project: LibreOffice Songbook Architect (LOSA)
http://struckkai.blogspot.de/2015/04/li ... itect.html

tmp
Beiträge: 13
Registriert: Sa 27. Aug 2022, 12:41

Re: [gelöst] [Writer] Absatzumbruch (¶) ersetzen

Beitrag von tmp » Sa 10. Sep 2022, 21:18

Hallo musikai,

dein Code funktioniert auch problemlos.

Danke. :-)

musikai
Beiträge: 262
Registriert: Do 14. Mai 2015, 17:53

Re: [gelöst] [Writer] Absatzumbruch (¶) ersetzen

Beitrag von musikai » So 11. Sep 2022, 16:05

Hab noch kurz meinen obigen code vereinfacht.

Wenn ich Dein letztes Beispiel an Deinem Test-Text anwende, wird stets eins der 2 Bilder gelöscht. (edit: passiert wohl nur auf meinem alten, langsamem Rechner, auf meinem modernerem System geht's ohne Probleme)

Leider liess mir das keine Ruhe und so habe ich dies zusammengestöpselt:

Code: Alles auswählen

rem lösche leere Zeilen, die kein bild oder umbruch haben, läßt aber eine  leere Zeile stehen 
Sub delete_empty_paras2
Dim a(0)
Call replace_whitespaces
oText = ThisComponent.Text
i=-1
countup=1
oTextEnumeration = oText.createEnumeration
rem disable Layout-update
rem ThisComponent.LockControllers()
    do while oTextEnumeration.hasmoreelements
     
        oPar = oTextEnumeration.nextelement
        	If len(oPar.getString()) = 0 and pic_or_break(oPar)= 0 then
        	    if countup=1 then
    		 	i=i+1
     			ReDim Preserve a(i)
     			countup=0
     			end if
  		             	
        	
        	a(i)=a(i)+1
        	  
        	else
    		 	i=i+1
     			ReDim Preserve a(i)
     			countup=1
  		      	
  		         
        	a(i)=0      
        	end if       
    loop

oTextEnumeration2 = oText.createEnumeration

i=0
for i=0 to ubound(a)
	k=1

	if a(i)>0 then
	
		for k=1 to a(i)-1
	
			oPar = oTextEnumeration2.nextelement
			oPar.dispose()
		next k
		oPar = oTextEnumeration2.nextelement
	else
		oPar = oTextEnumeration2.nextelement
	end if
next i

rem enable Layout-update
rem ThisComponent.UnLockControllers()

End Sub

function pic_or_break (oPar)
pic_or_break=0

If oPar.supportsService("com.sun.star.text.Paragraph") Then
		TextEnum = oPar.createEnumeration
	
		Do While TextEnum.hasMoreElements
			TextPortion = TextEnum.nextElement
				If TextPortion.BreakType <> 0 or TextPortion.TextPortionType="Frame" Then
					pic_or_break=1
				end if
		Loop
End If
end function

'===========================================
Sub replace_whitespaces

Dim Doc As Object
Dim Replace As Object

Doc = ThisComponent
Replace = Doc.createReplaceDescriptor
Replace.SearchRegularExpression = True
Replace.SearchString = "^\s*$"
Replace.ReplaceString = ""
Doc.replaceAll(Replace)

End Sub
Win7 Pro, Sibelius 7.1.3, Lubuntu 15.10, LibO 4.4.7, OO 4.1.3
Free Project: LibreOffice Songbook Architect (LOSA)
http://struckkai.blogspot.de/2015/04/li ... itect.html

An alle, die das LibreOffice-Forum nutzen:


Bitte beteiligen Sie sich mit 7 Euro pro Monat und helfen uns bei unserem Budget für das Jahr 2024.
Einfach per Kreditkarte oder PayPal.
Als Dankeschön werden Sie im Forum als LO-SUPPORTER gekennzeichnet.

❤️ Vielen lieben Dank für Ihre Unterstützung ❤️

Antworten