[Gelöst] Zelle mit best. Wert, Leerzeile darüber einfügen.

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

Moderator: Moderatoren

turtle47
*******
Beiträge: 1849
Registriert: Mi, 04.01.2006 20:10
Wohnort: Rheinbach

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von turtle47 »

Hallo,

ersetze mal den mittleren Teil durch:

Code: Alles auswählen

		....
		If NOT isNull(oResult) Then
			For Each cell in oResult
					r = cell.celladdress.row
						if osheet.getcellbyposition(5 , r-2).string = "" then
							goto Label_1'<- Zeile geändert
                        else
							orows.insertbyindex( r , 2 )
							osheet.getcellrangebyposition( 0 , r , 99 , r +1).cellstyle = "Standard"
						end if
							Label_1: '<- Zeile hinzugefügt
			Next cell
			....
Jürgen
Software hat keinen Verstand - benutze deinen eigenen...!

Win 7 SP1/ LibreOffice 3.4.2 OOO340m1 (Build:203) / Firefox 15.0.1 / Notebook ASUS K70IO 64 Bit-Betriebssytem
Benutzeravatar
MikeRo
****
Beiträge: 153
Registriert: Mi, 20.01.2010 10:16

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von MikeRo »

Ich habe mal etwas an dem Makro verändert und nun fügt es auf jeder Tabelle 2 Leerzeilen über Gesamtergebnis ein.
Allerdings immer wieder, falls es nochmals gestartet wird, ich habe die Überprüfung herausgenommen, da damit gar nichts mehr geht.
Jetzt geht es wenigstens das er es auf allen Tabellen macht.

Code: Alles auswählen

Sub Main

oDoc = thisComponent
for i = 0 to odoc.sheets().count() -1
oSheet = oDoc.Sheets( i )
orows = osheet.getrows
oRange = oSheet.getCellRangeByName( "A1:Z60000" )
oSearchDesc = oSheet.createSearchDescriptor
oSearchDesc.SearchString = "Gesamtergebnis"
oSearchDesc.searchWords = True
oResult = oRange.findAll(oSearchDesc)
If NOT isNull( oResult ) then
   For each cell in oResult
     orows.insertbyindex( cell.celladdress.row , 2 )     
     osheet.getcellrangebyposition( 0 , cell.celladdress.row -2 , 99 , cell.celladdress.row -1).cellstyle = "Standard"
   Next cell
End If
next i
end sub
OpenOffice 3.3 & postgresql-sdbc-driver 0.7.6b
Windows XP Professional SP3 x86
Benutzeravatar
MikeRo
****
Beiträge: 153
Registriert: Mi, 20.01.2010 10:16

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von MikeRo »

Ich habe das Makro noch ein mal geändert, aber der Fehler besteht immer noch, wenn die Schleife drin ist, die überprüft ob schon 2 Zeilen drüber sind.
Und die Aktuelle Version, ist ohne diese Überprüfung, allerdings funktioniert sie auf allen Tabellen perfekt (und nun muss auch nur noch eine Zeile eingefügt werden.) Aber ich brauche auch diese Überprüfung. Weil das Dokument nicht immer Vollständig erstellt wird und auch mal gespeichert und später wieder bearbeitet wird.

Code: Alles auswählen

Sub Main

oDoc = thisComponent
for i = 0 to odoc.sheets().count() -1
oSheet = oDoc.Sheets( i )
orows = osheet.getrows
oRange = oSheet.getCellRangeByName( "A1:Z60000" )
oSearchDesc = oSheet.createSearchDescriptor
oSearchDesc.SearchString = "Gesamtergebnis"
oSearchDesc.searchWords = True
oResult = oRange.findAll(oSearchDesc)
If NOT isNull( oResult ) then
   For each cell in oResult
     orows.insertbyindex( cell.celladdress.row , 1 )     
     osheet.getcellrangebyposition( 0 , cell.celladdress.row -1 , 99 , cell.celladdress.row -1).cellstyle = "Standard"
   Next cell
End If
next i
end sub
OpenOffice 3.3 & postgresql-sdbc-driver 0.7.6b
Windows XP Professional SP3 x86
DPunch
*******
Beiträge: 1112
Registriert: Mo, 02.11.2009 16:16
Wohnort: Marburg

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von DPunch »

Aloha
MikeRo hat geschrieben:Ich habe das Makro noch ein mal geändert, aber der Fehler besteht immer noch, wenn die Schleife drin ist, die überprüft ob schon 2 Zeilen drüber sind.
Es wäre für die Zukunft vielleicht hilfreich, wenn Du wenigstens sagen würdest, was für ein Fehler überhaupt auftritt.
(...)ich habe die Überprüfung herausgenommen, da damit gar nichts mehr geht.
Mit so einer Fehlerbeschreibung kann man, oder zumindest ich, herzlich wenig anfangen.

Code: Alles auswählen

	For each cell in oResult
		nRow = cell.celladdress.row
		nCol = cell.celladdress.column
		If Len(oSheet.getCellByPosition(nCol,nRow-1).String) > 0 Then
			orows.insertbyindex( nRow , 1 )     
			osheet.getcellrangebyposition( 0 , nRow -1 , 99 , nRow -1).cellstyle = "Standard"
		End If
	Next cell
Benutzeravatar
MikeRo
****
Beiträge: 153
Registriert: Mi, 20.01.2010 10:16

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von MikeRo »

Das Problem ist, dass er mit der Überprüfung nur in der ersten Tabelle eine Zeile über Gesamtergebnis hinzufügt und alle anderen nicht weiter beachtet, egal wie oft ich es ausführe und mein eigenes Makro wird danach auch nicht mehr gestartet. In der Version ohne die Überprüfung geht es in jeder Tabelle da wird Gesamtergebnis verrückt und Ergebnis gelöscht.

Code: Alles auswählen

Sub Main

oDoc = thisComponent
for i = 0 to odoc.sheets().count() -1
oSheet = oDoc.Sheets( i )
orows = osheet.getrows
oRange = oSheet.getCellRangeByName( "A1:Z60000" )
oSearchDesc = oSheet.createSearchDescriptor
oSearchDesc.SearchString = "Gesamtergebnis"
oSearchDesc.searchWords = True
oResult = oRange.findAll(oSearchDesc)
If NOT isNull( oResult ) then
   For each cell in oResult
     orows.insertbyindex( cell.celladdress.row , 2 )     
     osheet.getcellrangebyposition( 0 , cell.celladdress.row -2 , 99 , cell.celladdress.row -1).cellstyle = "Standard"
   Next cell
End If
next i

rem --------------------------------------------------------suchen und ersetzen
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:TableSelectAll", "", 0, Array())

rem ----------------------------------------------------------------------
dim args2(17) as new com.sun.star.beans.PropertyValue
args2(0).Name = "SearchItem.StyleFamily"
args2(0).Value = 2
args2(1).Name = "SearchItem.CellType"
args2(1).Value = 1
args2(2).Name = "SearchItem.RowDirection"
args2(2).Value = false
args2(3).Name = "SearchItem.AllTables"
args2(3).Value = false
args2(4).Name = "SearchItem.Backward"
args2(4).Value = false
args2(5).Name = "SearchItem.Pattern"
args2(5).Value = false
args2(6).Name = "SearchItem.Content"
args2(6).Value = false
args2(7).Name = "SearchItem.AsianOptions"
args2(7).Value = false
args2(8).Name = "SearchItem.AlgorithmType"
args2(8).Value = 0
args2(9).Name = "SearchItem.SearchFlags"
args2(9).Value = 65536
args2(10).Name = "SearchItem.SearchString"
args2(10).Value = "Ergebnis"
args2(11).Name = "SearchItem.ReplaceString"
args2(11).Value = ""
args2(12).Name = "SearchItem.Locale"
args2(12).Value = 255
args2(13).Name = "SearchItem.ChangedChars"
args2(13).Value = 2
args2(14).Name = "SearchItem.DeletedChars"
args2(14).Value = 2
args2(15).Name = "SearchItem.InsertedChars"
args2(15).Value = 2
args2(16).Name = "SearchItem.TransliterateFlags"
args2(16).Value = 1024
args2(17).Name = "SearchItem.Command"
args2(17).Value = 1

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args2())

rem ----------------------------------------------------------------------
dim args3(17) as new com.sun.star.beans.PropertyValue
args3(0).Name = "SearchItem.StyleFamily"
args3(0).Value = 2
args3(1).Name = "SearchItem.CellType"
args3(1).Value = 1
args3(2).Name = "SearchItem.RowDirection"
args3(2).Value = false
args3(3).Name = "SearchItem.AllTables"
args3(3).Value = false
args3(4).Name = "SearchItem.Backward"
args3(4).Value = false
args3(5).Name = "SearchItem.Pattern"
args3(5).Value = false
args3(6).Name = "SearchItem.Content"
args3(6).Value = false
args3(7).Name = "SearchItem.AsianOptions"
args3(7).Value = false
args3(8).Name = "SearchItem.AlgorithmType"
args3(8).Value = 0
args3(9).Name = "SearchItem.SearchFlags"
args3(9).Value = 65536
args3(10).Name = "SearchItem.SearchString"
args3(10).Value = "Ergebnis"
args3(11).Name = "SearchItem.ReplaceString"
args3(11).Value = ""
args3(12).Name = "SearchItem.Locale"
args3(12).Value = 255
args3(13).Name = "SearchItem.ChangedChars"
args3(13).Value = 2
args3(14).Name = "SearchItem.DeletedChars"
args3(14).Value = 2
args3(15).Name = "SearchItem.InsertedChars"
args3(15).Value = 2
args3(16).Name = "SearchItem.TransliterateFlags"
args3(16).Value = 1024
args3(17).Name = "SearchItem.Command"
args3(17).Value = 1

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(17) as new com.sun.star.beans.PropertyValue
args4(0).Name = "SearchItem.StyleFamily"
args4(0).Value = 2
args4(1).Name = "SearchItem.CellType"
args4(1).Value = 1
args4(2).Name = "SearchItem.RowDirection"
args4(2).Value = false
args4(3).Name = "SearchItem.AllTables"
args4(3).Value = false
args4(4).Name = "SearchItem.Backward"
args4(4).Value = false
args4(5).Name = "SearchItem.Pattern"
args4(5).Value = false
args4(6).Name = "SearchItem.Content"
args4(6).Value = false
args4(7).Name = "SearchItem.AsianOptions"
args4(7).Value = false
args4(8).Name = "SearchItem.AlgorithmType"
args4(8).Value = 0
args4(9).Name = "SearchItem.SearchFlags"
args4(9).Value = 65536
args4(10).Name = "SearchItem.SearchString"
args4(10).Value = "Ergebnis"
args4(11).Name = "SearchItem.ReplaceString"
args4(11).Value = ""
args4(12).Name = "SearchItem.Locale"
args4(12).Value = 255
args4(13).Name = "SearchItem.ChangedChars"
args4(13).Value = 2
args4(14).Name = "SearchItem.DeletedChars"
args4(14).Value = 2
args4(15).Name = "SearchItem.InsertedChars"
args4(15).Value = 2
args4(16).Name = "SearchItem.TransliterateFlags"
args4(16).Value = 1024
args4(17).Name = "SearchItem.Command"
args4(17).Value = 3

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args4())


end sub

OpenOffice 3.3 & postgresql-sdbc-driver 0.7.6b
Windows XP Professional SP3 x86
DPunch
*******
Beiträge: 1112
Registriert: Mo, 02.11.2009 16:16
Wohnort: Marburg

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von DPunch »

Aloha
MikeRo hat geschrieben:Das Problem ist, dass er mit der Überprüfung nur in der ersten Tabelle eine Zeile über Gesamtergebnis hinzufügt und alle anderen nicht weiter beachtet
Dann stimmt was mit deinen Tabellen nicht, ich habe das von Dir gepostete Makro ergänzt mit der Überprüfung einfach hier rauskopiert und es macht haargenau das, was Dir vorschwebt - und zwar (logischerweise, schliesslich läuft das Ganze in einer Schleife) in allen Tabellen.
Benutzeravatar
MikeRo
****
Beiträge: 153
Registriert: Mi, 20.01.2010 10:16

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von MikeRo »

DPunch hat geschrieben:Aloha
MikeRo hat geschrieben:Das Problem ist, dass er mit der Überprüfung nur in der ersten Tabelle eine Zeile über Gesamtergebnis hinzufügt und alle anderen nicht weiter beachtet
Dann stimmt was mit deinen Tabellen nicht, ich habe das von Dir gepostete Makro ergänzt mit der Überprüfung einfach hier rauskopiert und es macht haargenau das, was Dir vorschwebt - und zwar (logischerweise, schliesslich läuft das Ganze in einer Schleife) in allen Tabellen.
Danke für die Hilfe, es geht jetzt, das einzige Problem ist noch, das nun die Zeilen drüber nicht die Standartformatierung haben, sondern die vom Ergebnis.
OpenOffice 3.3 & postgresql-sdbc-driver 0.7.6b
Windows XP Professional SP3 x86
DPunch
*******
Beiträge: 1112
Registriert: Mo, 02.11.2009 16:16
Wohnort: Marburg

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von DPunch »

Aloha
MikeRo hat geschrieben:das einzige Problem ist noch, das nun die Zeilen drüber nicht die Standartformatierung haben, sondern die vom Ergebnis.
Was meinst Du mit "nun"? Wenn die Formatierung vorher zurückgesetzt wurde, wird sie das auch jetzt noch.
Oder hat das Zurücksetzen gar nicht erst funktioniert?
Benutzeravatar
MikeRo
****
Beiträge: 153
Registriert: Mi, 20.01.2010 10:16

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von MikeRo »

DPunch hat geschrieben:Aloha
MikeRo hat geschrieben:das einzige Problem ist noch, das nun die Zeilen drüber nicht die Standartformatierung haben, sondern die vom Ergebnis.
Was meinst Du mit "nun"? Wenn die Formatierung vorher zurückgesetzt wurde, wird sie das auch jetzt noch.
Oder hat das Zurücksetzen gar nicht erst funktioniert?
Doch eigentlich ging es vorher. Nun übernimmt er für die neue Zeile, die Formatierung der Zeile darüber.
Ich habe es mal einfach in einem neuen Dokument getestet.

Ergebnis
Gesamtergebnis
Ergebnis
Gesamtergebnis
TestTest rot hinterlegt
Gesamtergebnis

Die Zeile ist dann auch Rot hinterlegt. Alles andere geht und auch auf jeder Tabelle
OpenOffice 3.3 & postgresql-sdbc-driver 0.7.6b
Windows XP Professional SP3 x86
DPunch
*******
Beiträge: 1112
Registriert: Mo, 02.11.2009 16:16
Wohnort: Marburg

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von DPunch »

Aloha

Die entsprechende Codezeile einfach folgendermaßen anpassen:

Code: Alles auswählen

osheet.getcellrangebyposition( 0 , nRow , 99 , nRow ).cellstyle = "Standard"
Benutzeravatar
MikeRo
****
Beiträge: 153
Registriert: Mi, 20.01.2010 10:16

Re: Zelle mit best. Wert, Leerzeile darüber einfügen? Überall

Beitrag von MikeRo »

Tausend Dank an alle :)

Es scheint nun zu funktionieren. Ich werde es noch mal genauer testen.

Code: Alles auswählen

Sub Main

oDoc = thisComponent
for i = 0 to odoc.sheets().count() -1
oSheet = oDoc.Sheets( i )
orows = osheet.getrows
oRange = oSheet.getCellRangeByName( "A1:Z60000" )
oSearchDesc = oSheet.createSearchDescriptor
oSearchDesc.SearchString = "Gesamtergebnis"
oSearchDesc.searchWords = True
oResult = oRange.findAll(oSearchDesc)
If NOT isNull( oResult ) then
      For each cell in oResult
      nRow = cell.celladdress.row
      nCol = cell.celladdress.column
      If Len(oSheet.getCellByPosition(nCol,nRow-1).String) > 0 Then
         orows.insertbyindex( nRow , 1 )     
         osheet.getcellrangebyposition( 0 , nRow , 99 , nRow ).cellstyle = "Standard"
      End If
   Next cell
End If
next i

rem --------------------------------------------------------suchen und ersetzen
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:TableSelectAll", "", 0, Array())

rem ----------------------------------------------------------------------
dim args2(17) as new com.sun.star.beans.PropertyValue
args2(0).Name = "SearchItem.StyleFamily"
args2(0).Value = 2
args2(1).Name = "SearchItem.CellType"
args2(1).Value = 1
args2(2).Name = "SearchItem.RowDirection"
args2(2).Value = false
args2(3).Name = "SearchItem.AllTables"
args2(3).Value = false
args2(4).Name = "SearchItem.Backward"
args2(4).Value = false
args2(5).Name = "SearchItem.Pattern"
args2(5).Value = false
args2(6).Name = "SearchItem.Content"
args2(6).Value = false
args2(7).Name = "SearchItem.AsianOptions"
args2(7).Value = false
args2(8).Name = "SearchItem.AlgorithmType"
args2(8).Value = 0
args2(9).Name = "SearchItem.SearchFlags"
args2(9).Value = 65536
args2(10).Name = "SearchItem.SearchString"
args2(10).Value = "Ergebnis"
args2(11).Name = "SearchItem.ReplaceString"
args2(11).Value = ""
args2(12).Name = "SearchItem.Locale"
args2(12).Value = 255
args2(13).Name = "SearchItem.ChangedChars"
args2(13).Value = 2
args2(14).Name = "SearchItem.DeletedChars"
args2(14).Value = 2
args2(15).Name = "SearchItem.InsertedChars"
args2(15).Value = 2
args2(16).Name = "SearchItem.TransliterateFlags"
args2(16).Value = 1024
args2(17).Name = "SearchItem.Command"
args2(17).Value = 1

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args2())

rem ----------------------------------------------------------------------
dim args3(17) as new com.sun.star.beans.PropertyValue
args3(0).Name = "SearchItem.StyleFamily"
args3(0).Value = 2
args3(1).Name = "SearchItem.CellType"
args3(1).Value = 1
args3(2).Name = "SearchItem.RowDirection"
args3(2).Value = false
args3(3).Name = "SearchItem.AllTables"
args3(3).Value = false
args3(4).Name = "SearchItem.Backward"
args3(4).Value = false
args3(5).Name = "SearchItem.Pattern"
args3(5).Value = false
args3(6).Name = "SearchItem.Content"
args3(6).Value = false
args3(7).Name = "SearchItem.AsianOptions"
args3(7).Value = false
args3(8).Name = "SearchItem.AlgorithmType"
args3(8).Value = 0
args3(9).Name = "SearchItem.SearchFlags"
args3(9).Value = 65536
args3(10).Name = "SearchItem.SearchString"
args3(10).Value = "Ergebnis"
args3(11).Name = "SearchItem.ReplaceString"
args3(11).Value = ""
args3(12).Name = "SearchItem.Locale"
args3(12).Value = 255
args3(13).Name = "SearchItem.ChangedChars"
args3(13).Value = 2
args3(14).Name = "SearchItem.DeletedChars"
args3(14).Value = 2
args3(15).Name = "SearchItem.InsertedChars"
args3(15).Value = 2
args3(16).Name = "SearchItem.TransliterateFlags"
args3(16).Value = 1024
args3(17).Name = "SearchItem.Command"
args3(17).Value = 1

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(17) as new com.sun.star.beans.PropertyValue
args4(0).Name = "SearchItem.StyleFamily"
args4(0).Value = 2
args4(1).Name = "SearchItem.CellType"
args4(1).Value = 1
args4(2).Name = "SearchItem.RowDirection"
args4(2).Value = false
args4(3).Name = "SearchItem.AllTables"
args4(3).Value = false
args4(4).Name = "SearchItem.Backward"
args4(4).Value = false
args4(5).Name = "SearchItem.Pattern"
args4(5).Value = false
args4(6).Name = "SearchItem.Content"
args4(6).Value = false
args4(7).Name = "SearchItem.AsianOptions"
args4(7).Value = false
args4(8).Name = "SearchItem.AlgorithmType"
args4(8).Value = 0
args4(9).Name = "SearchItem.SearchFlags"
args4(9).Value = 65536
args4(10).Name = "SearchItem.SearchString"
args4(10).Value = "Ergebnis"
args4(11).Name = "SearchItem.ReplaceString"
args4(11).Value = ""
args4(12).Name = "SearchItem.Locale"
args4(12).Value = 255
args4(13).Name = "SearchItem.ChangedChars"
args4(13).Value = 2
args4(14).Name = "SearchItem.DeletedChars"
args4(14).Value = 2
args4(15).Name = "SearchItem.InsertedChars"
args4(15).Value = 2
args4(16).Name = "SearchItem.TransliterateFlags"
args4(16).Value = 1024
args4(17).Name = "SearchItem.Command"
args4(17).Value = 3

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args4())


end sub
OpenOffice 3.3 & postgresql-sdbc-driver 0.7.6b
Windows XP Professional SP3 x86
Antworten