Makro (CALC) ein bestimmtes Wort finden und komplette Zeile kopieren

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

Moderator: Moderatoren

clag
********
Beiträge: 3557
Registriert: Di, 27.01.2009 15:30

Makro (CALC) ein bestimmtes Wort finden und komplette Zeile kopieren

Beitrag von clag » Fr, 12.07.2019 05:37

Hallo Gemeinde ,
foldendes wurde ich per PM gefragt, kann aber nicht helfen da ich LO nicht nutze.

Hallo clag,

Du hattest hier vor einiger Zeit ein echt tolles Makro gepostet:
http://oooforum.de/viewtopic.php?t=65995

Und zwar zwei Versionen bzw. ein sehr einfaches -
findeText_kopiereZeile.ods - und dann ein stark erweitertes -
findeText_kopiere_alle_Zeilen.ods -, das ich für eine private Tabelle super
brauchen könnte.

Jedoch läuft bei mir dieses erweiterte Makro - ich nutze LibreOffice in der
aktuellsten Version - genau ein Mal.
Denn bei der zweiten Suche nach einem String in Deiner Beispieltabelle
bricht das Makro mit folgender Fehlermeldung ab:

BASIC-Laufzeitfehler:
Eigenschaft oder Methode nicht gefunden: Spreadsheet

Der Fehler wird angezeigt in Zeile 5:
oSheet = oCalc.CurrentSelection.Spreadsheet

Das Makro läuft nur dann tadellos weiter, wenn man das erstellte neue Blatt
mit den Suchergebnissen vor einer weiteren Suche löscht.

Weißt Du vielleicht, woran das liegt und wie man dieses Problem beheben
kann ?
LG
clag

nutzt: WinXP SP3 / AOO 4.1.6 / Firefox

F3K Total
********
Beiträge: 3359
Registriert: Mo, 28.02.2011 17:49

Re: Makro (CALC) ein bestimmtes Wort finden und komplette Zeile kopieren

Beitrag von F3K Total » Sa, 13.07.2019 18:26

Hallo Clag,
habe mir deine Datei heruntgeladen und unter LibreOffice 6.2.5 getestet.
Ich kann keinen Fehler feststellen, läuft bei mir einwandfrei.

Gruß R

F3K Total
********
Beiträge: 3359
Registriert: Mo, 28.02.2011 17:49

Re: Makro (CALC) ein bestimmtes Wort finden und komplette Zeile kopieren

Beitrag von F3K Total » Sa, 13.07.2019 18:32

... hier noch ein Bild dazu ...
CLAG.png
CLAG.png (68.27 KiB) 174 mal betrachtet

clag
********
Beiträge: 3557
Registriert: Di, 27.01.2009 15:30

Re: Makro (CALC) ein bestimmtes Wort finden und komplette Zeile kopieren

Beitrag von clag » Sa, 13.07.2019 19:01

Hallo F3K Total

vielen Dank, das Du Dir die Mühe gemacht hast es zu überprüfen.
Ich hoffe dem ursprünglichen Fragesteller hilft es weiter.

Ich selbst habe die Datei auch heruterladen müssen um zu sehen was Ich eigentlich da mal angestellt habe.
Dabei ist mir dann noch die Idee gekommen ggf den Text der akuellen Zelle zur Suche einzuspannen.

zwei Zeilen zusätzlich

Code: Alles auswählen

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

sub FindeStringKopiereFundzeile
oCalc = ThisComponent
oSheet = oCalc.CurrentSelection.Spreadsheet 

'--------------------------------------------------
'suchstring aus der selektierten Zelle lesen 
	myString = oCalc.CurrentSelection.String
'--------------------------------------------------
'suchstring beliebig eingeben 
'	myString = InputBox( _
'	"bei Fund, eine weitere so benannte Tabelle erstellen " & chr(10) & _
'	"und in Diese, dann die gesamte Fundzeile kopieren" & chr(10) & _
'	"es können auch mehrere Suchbegriffe ';' getrennt eingegeben werden" _
'	,"den eingegebenen Begiff suchen ")
'--------------------------------------------------

	if Len(myString) = 0  then
		MsgBox("nichts eingegeben Aktion abgebrochen")
		exit sub
	end if

	mAllText = split(myString,";")
	for i=0 to uBound(mAllText)
	result = SucheNach( mAllText(i))
		if result = "-"  then
			mAllText(i) = mAllText(i) & " - nicht gefunden, keine weitere Aktion" 
			goto jumpover
		else
			ix=1 
			newTable = mAllText(i)
			do while oCalc.Sheets.hasByName(newTable) 
				ix = ix+1
				newTable = mAllText(i) & "(" & ix &")"
				if oCalc.Sheets.count > 255 then 
					msgbox "zu viele Tabellenblätter"
					exit sub
				endif
			loop
			Sheet=oCalc.createInstance("com.sun.star.sheet.Spreadsheet")
			oCalc.Sheets.insertByName(newTable, sheet)
		endif
	oSheet2 = oCalc.Sheets.getByName(newTable)
	oSourceRange = oSheet.getCellRangeByPosition(0,result,1023,result)
	oSourceRangeAddresse = oSourceRange.getRangeAddress
	oTarget = oSheet2.getCellByPosition(0,1)
	oTargetCellAdresse = oTarget.getCellAddress
	oSheet2.copyRange(oTargetCellAdresse,oSourceRangeAddresse)
	mAllText(i) = "Tabelle " & newTable & " erstellt und Zeile " & result+1 & " kopiert "
	jumpover:
	next 
	msgbox join(mAllText(), chr(10)) 
end sub 


'==============================================================================

function SucheNach( sText$ )

rem ----------------------------------------------------------------------
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")

dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "Sel"
args1(0).Value = false
dispatcher.executeDispatch(document, ".uno:GoToStart", "", 0, args1())

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 = 0
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 = 1
args2(9).Name = "SearchItem.SearchFlags"
args2(9).Value = 65536
args2(10).Name = "SearchItem.SearchString"
args2(10).Value = "^" & sText & "$"
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 = 0
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args2())

	if ThisComponent.CurrentSelection.String = sText then
		SucheNach = ThisComponent.CurrentSelection.CellAddress.Row
	else
		SucheNach = "-"
	endif		

end function


Ich hoffe es hilft irgend einem Leser einmal.

findeText_kopiereZeile.ods
(19.7 KiB) 2-mal heruntergeladen
LG
clag

nutzt: WinXP SP3 / AOO 4.1.6 / Firefox

Antworten