von Pretender1970 » Mi, 23.06.2021 16:07
Vielen Dank euch beiden für die tolle Unterstützung. Ich habe jetzt mal den gesamten Code angefügt.
Das Makro sucht nach dem Begriff und erstellt danach eine neue Tabelle mit dem Suchergebnis. Das klappt
auch wunderbar, allerdings eben nur der exakte Suchbegriff...Auch muss ich feststellen, dass die Formate#
wie Zeilengröße und Spaltenbreite nicht richtig übernommen werden.
sub Findeundkopiereergebnis
oCalc = ThisComponent
oSheet = oCalc.CurrentSelection.Spreadsheet
Dim oDialog as object
Dim iDlgOK as integer
DialogLibraries.loadLibrary( "Standard")
oDialogLib = DialogLibraries.getByName("Standard")
oDialog = CreateUnoDialog(oDialogLib.getByName("Dialog1"))
iDlgOK = oDialog.Execute()
if iDlgOK = 1 then
bHL = oDialog.Model.CheckBox1.state
myString = oDialog.GetControl("TextField1").Text
end if
oDialog.dispose()
if Len(myString) = 0 then exit sub
oCalc.lockcontrollers
mAllText = split(myString,";")
for i=0 to uBound(mAllText)
result = FindeAlle( mAllText(i), Sel)
if result(0) = "-" then
mAllText(i) = mAllText(i) & " - leider kein Suchergebnis"
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 > 10 then
msgbox "uups, zuviele Tabellenblätter, bitte Tabellen mit Suchergebnissen löschen"
exit sub
endif
loop
Sheet=oCalc.createInstance("com.sun.star.sheet.Spreadsheet")
oCalc.Sheets.insertByName(newTable, sheet)
endif
if bHL = 1 then
oSheet2 = oCalc.Sheets.getByName(newTable)
oSourceRange = oSheet.getCellRangeByPosition(0,0,1023,0)
oSourceRangeAddresse = oSourceRange.getRangeAddress
oTarget = oSheet2.getCellByPosition(0,0)
oTargetCellAdresse = oTarget.getCellAddress
oSheet2.copyRange(oTargetCellAdresse,oSourceRangeAddresse)
end if
for iR = 0 to uBound(result)
oSheet2 = oCalc.Sheets.getByName(newTable)
oSourceRange = oSheet.getCellRangeByPosition(0,result(ir),1023,result(iR))
oSourceRangeAddresse = oSourceRange.getRangeAddress
oTarget = oSheet2.getCellByPosition(0,iR+1)
oTargetCellAdresse = oTarget.getCellAddress
oSheet2.copyRange(oTargetCellAdresse,oSourceRangeAddresse)
oSheet2.Columns.OptimalWidth = True
next
jumpover:
next
oCalc.unlockcontrollers
myView = oCalc.CurrentController
osheet = oCalc.sheets(0)
mycell = osheet.getCellByPosition(XC,XR)
myView.Select(mycell)
gostart
end sub
function FindeAlle (sText, iSel )
SFlag = 71696
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")
if iSel = 0 then
SFlag = 65552
rem ----------------------------------------------------------------------
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())
endif
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 = true
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 = SFlag
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 = 1
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args2())
oCalc = thisComponent
Selected = oCalc.CurrentSelection
if Selected.supportsService("com.sun.star.sheet.SheetCell" ) then
dim eRow(0)
eRow(0) = Selected.CellAddress.Row
if Selected.String = sText then
FindeAlle = eRow()
else
eRow(0) = "-"
FindeAlle = eRow()
endif
end if
if Selected.supportsService("com.sun.star.sheet.SheetCellRanges" ) then
nR = uBound(Selected.RangeAddresses())
dim xRows(nR) as String
for i=0 to nR
xRows(i) = Selected.rangeAddresses(i).StartRow
next
FindeAlle = xRows()
end if
end function
sub FindeAlleSelection
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")
rem ----------------------------------------------------------------------
dim args1(17) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.Backward"
args1(4).Value = false
args1(5).Name = "SearchItem.Pattern"
args1(5).Value = false
args1(6).Name = "SearchItem.Content"
args1(6).Value = false
args1(7).Name = "SearchItem.AsianOptions"
args1(7).Value = false
args1(8).Name = "SearchItem.AlgorithmType"
args1(8).Value = 0
args1(9).Name = "SearchItem.SearchFlags"
args1(9).Value = 71696
args1(10).Name = "SearchItem.SearchString"
args1(10).Value = "Frank"
args1(11).Name = "SearchItem.ReplaceString"
args1(11).Value = ""
args1(12).Name = "SearchItem.Locale"
args1(12).Value = 255
args1(13).Name = "SearchItem.ChangedChars"
args1(13).Value = 2
args1(14).Name = "SearchItem.DeletedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.InsertedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.TransliterateFlags"
args1(16).Value = 1280
args1(17).Name = "SearchItem.Command"
args1(17).Value = 1
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
end sub
sub gostart
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")
rem ----------------------------------------------------------------------
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())
end sub
Vielen Dank euch beiden für die tolle Unterstützung. Ich habe jetzt mal den gesamten Code angefügt.
Das Makro sucht nach dem Begriff und erstellt danach eine neue Tabelle mit dem Suchergebnis. Das klappt
auch wunderbar, allerdings eben nur der exakte Suchbegriff...Auch muss ich feststellen, dass die Formate#
wie Zeilengröße und Spaltenbreite nicht richtig übernommen werden.
sub Findeundkopiereergebnis
oCalc = ThisComponent
oSheet = oCalc.CurrentSelection.Spreadsheet
Dim oDialog as object
Dim iDlgOK as integer
DialogLibraries.loadLibrary( "Standard")
oDialogLib = DialogLibraries.getByName("Standard")
oDialog = CreateUnoDialog(oDialogLib.getByName("Dialog1"))
iDlgOK = oDialog.Execute()
if iDlgOK = 1 then
bHL = oDialog.Model.CheckBox1.state
myString = oDialog.GetControl("TextField1").Text
end if
oDialog.dispose()
if Len(myString) = 0 then exit sub
oCalc.lockcontrollers
mAllText = split(myString,";")
for i=0 to uBound(mAllText)
result = FindeAlle( mAllText(i), Sel)
if result(0) = "-" then
mAllText(i) = mAllText(i) & " - leider kein Suchergebnis"
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 > 10 then
msgbox "uups, zuviele Tabellenblätter, bitte Tabellen mit Suchergebnissen löschen"
exit sub
endif
loop
Sheet=oCalc.createInstance("com.sun.star.sheet.Spreadsheet")
oCalc.Sheets.insertByName(newTable, sheet)
endif
if bHL = 1 then
oSheet2 = oCalc.Sheets.getByName(newTable)
oSourceRange = oSheet.getCellRangeByPosition(0,0,1023,0)
oSourceRangeAddresse = oSourceRange.getRangeAddress
oTarget = oSheet2.getCellByPosition(0,0)
oTargetCellAdresse = oTarget.getCellAddress
oSheet2.copyRange(oTargetCellAdresse,oSourceRangeAddresse)
end if
for iR = 0 to uBound(result)
oSheet2 = oCalc.Sheets.getByName(newTable)
oSourceRange = oSheet.getCellRangeByPosition(0,result(ir),1023,result(iR))
oSourceRangeAddresse = oSourceRange.getRangeAddress
oTarget = oSheet2.getCellByPosition(0,iR+1)
oTargetCellAdresse = oTarget.getCellAddress
oSheet2.copyRange(oTargetCellAdresse,oSourceRangeAddresse)
oSheet2.Columns.OptimalWidth = True
next
jumpover:
next
oCalc.unlockcontrollers
myView = oCalc.CurrentController
osheet = oCalc.sheets(0)
mycell = osheet.getCellByPosition(XC,XR)
myView.Select(mycell)
gostart
end sub
function FindeAlle (sText, iSel )
SFlag = 71696
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")
if iSel = 0 then
SFlag = 65552
rem ----------------------------------------------------------------------
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())
endif
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 = true
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 = SFlag
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 = 1
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args2())
oCalc = thisComponent
Selected = oCalc.CurrentSelection
if Selected.supportsService("com.sun.star.sheet.SheetCell" ) then
dim eRow(0)
eRow(0) = Selected.CellAddress.Row
if Selected.String = sText then
FindeAlle = eRow()
else
eRow(0) = "-"
FindeAlle = eRow()
endif
end if
if Selected.supportsService("com.sun.star.sheet.SheetCellRanges" ) then
nR = uBound(Selected.RangeAddresses())
dim xRows(nR) as String
for i=0 to nR
xRows(i) = Selected.rangeAddresses(i).StartRow
next
FindeAlle = xRows()
end if
end function
sub FindeAlleSelection
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")
rem ----------------------------------------------------------------------
dim args1(17) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.Backward"
args1(4).Value = false
args1(5).Name = "SearchItem.Pattern"
args1(5).Value = false
args1(6).Name = "SearchItem.Content"
args1(6).Value = false
args1(7).Name = "SearchItem.AsianOptions"
args1(7).Value = false
args1(8).Name = "SearchItem.AlgorithmType"
args1(8).Value = 0
args1(9).Name = "SearchItem.SearchFlags"
args1(9).Value = 71696
args1(10).Name = "SearchItem.SearchString"
args1(10).Value = "Frank"
args1(11).Name = "SearchItem.ReplaceString"
args1(11).Value = ""
args1(12).Name = "SearchItem.Locale"
args1(12).Value = 255
args1(13).Name = "SearchItem.ChangedChars"
args1(13).Value = 2
args1(14).Name = "SearchItem.DeletedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.InsertedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.TransliterateFlags"
args1(16).Value = 1280
args1(17).Name = "SearchItem.Command"
args1(17).Value = 1
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
end sub
sub gostart
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")
rem ----------------------------------------------------------------------
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())
end sub