OpenOffice.info

Hiker hat geschrieben: ↑Do, 28.07.2022 08:11 Hallo,

zur Erklärung: Karolus hat deine ursprüngliche Routine Kurs (die im aktiven Tabellenblatt arbeitete) um 2 Parameter erweitert - sie bekommt das zu bearbeitende Dokument und den Tabellennamen übergeben.

In der Routine findest Du deshalb bei der "Navigation" mittels ToPoint-Aufrufen jetzt auch immer den Blattnamen mit angegeben.

Als Nebeneffekt müssen diese beiden Parameter nun beim Aufruf mit angegeben werden, daher die Fehlermeldung.

Da die Schleife "für alle Tabellen" in Main steckt, musst Du natürlich auch Main aufrufen, wenn alle Blätter bearbeitet werden sollen (und der Aufruf für Summenprodukt steht auch dort...)

J.

Karolus hat geschrieben: ↑Mo, 25.07.2022 20:49 Hallo

Karolus hat geschrieben: ↑Mo, 25.07.2022 20:49 Hallo

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


Sub Main
Doc = ThisComponent
for each sheet in Doc.sheets
Cell = sheet.getCellByPosition(3, 66)
Cell.Formulalocal = "=SUMMENPRODUKT(F5:F45=""Begriff"";D5:D45)"
kurs(Doc, sheet.Name)
next sheet
EUR(Doc)
End Sub


sub Kurs(doc, sheetname)

document = doc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
args2(0).Value = sheetname &".$E$1:$F$1"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2())


dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "Flags"
args3(0).Value = "SVDFN"
dispatcher.executeDispatch(document, ".uno:Delete", "", 0, args3())


dim args7(0) as new com.sun.star.beans.PropertyValue
args7(0).Name = "ToPoint"
args7(0).Value = sheetname &".$D$1"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args7())


dim args8(17) as new com.sun.star.beans.PropertyValue
args8(0).Name = "SearchItem.StyleFamily"
args8(0).Value = 2
args8(1).Name = "SearchItem.CellType"
args8(1).Value = 0
args8(2).Name = "SearchItem.RowDirection"
args8(2).Value = true
args8(3).Name = "SearchItem.AllTables"
args8(3).Value = false
args8(4).Name = "SearchItem.Backward"
args8(4).Value = false
args8(5).Name = "SearchItem.Pattern"
args8(5).Value = false
args8(6).Name = "SearchItem.Content"
args8(6).Value = false
args8(7).Name = "SearchItem.AsianOptions"
args8(7).Value = false
args8(8).Name = "SearchItem.AlgorithmType"
args8(8).Value = 1
args8(9).Name = "SearchItem.SearchFlags"
args8(9).Value = 65536
args8(10).Name = "SearchItem.SearchString"
args8(10).Value = "aktueller Kurs"
args8(11).Name = "SearchItem.ReplaceString"
args8(11).Value = ""
args8(12).Name = "SearchItem.Locale"
args8(12).Value = 255
args8(13).Name = "SearchItem.ChangedChars"
args8(13).Value = 2
args8(14).Name = "SearchItem.DeletedChars"
args8(14).Value = 2
args8(15).Name = "SearchItem.InsertedChars"
args8(15).Value = 2
args8(16).Name = "SearchItem.TransliterateFlags"
args8(16).Value = 1280
args8(17).Name = "SearchItem.Command"
args8(17).Value = 0
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args8())


dim args9(1) as new com.sun.star.beans.PropertyValue
args9(0).Name = "By"
args9(0).Value = 1
args9(1).Name = "Sel"
args9(1).Value = true
dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args9())


dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())


dim args11(0) as new com.sun.star.beans.PropertyValue
args11(0).Name = "ToPoint"
args11(0).Value = sheetname &".$E$1"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args11())


dim args12(5) as new com.sun.star.beans.PropertyValue
args12(0).Name = "Flags"
args12(0).Value = "SV"
args12(1).Name = "FormulaCommand"
args12(1).Value = 0
args12(2).Name = "SkipEmptyCells"
args12(2).Value = false
args12(3).Name = "Transpose"
args12(3).Value = false
args12(4).Name = "AsLink"
args12(4).Value = false
args12(5).Name = "MoveMode"
args12(5).Value = 4
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args12())


end sub


sub EUR(doc)

document = doc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")


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 = true
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 = 1
args1(9).Name = "SearchItem.SearchFlags"
args1(9).Value = 65536
args1(10).Name = "SearchItem.SearchString"
args1(10).Value = "EUR"
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 = 3

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


end sub

Girgei hat geschrieben: ↑Mo, 25.07.2022 13:58 zufällig habe ich eben erst gesehen, dass es ein eigenes Makro-Forum gibt. Daher hier nochmals meine Anliegen:

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

Sub Main
Dim Doc As Object
Dim Sheet As Object
Dim Cell As Object

Doc = ThisComponent
for sheetnumber =0 to doc.sheets.count-1
Sheet = Doc.Sheets(sheetnumber)
Cell = Sheet.getCellByPosition(3, 66)
Cell.Formulalocal = "=SUMMENPRODUKT(((F5:F45=""Begriff""))*(D5:D45))"
next sheetnumber

End Sub


sub Kurs
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 = "ToPoint"
args1(0).Value = "$D$9"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
args2(0).Value = "$E$1:$F$1"

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

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "Flags"
args3(0).Value = "SVDFN"

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

rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "ToPoint"
args4(0).Value = "$G$10"

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

rem ----------------------------------------------------------------------
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = "ToPoint"
args5(0).Value = "$F$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args5())

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

rem ----------------------------------------------------------------------
dim args7(0) as new com.sun.star.beans.PropertyValue
args7(0).Name = "ToPoint"
args7(0).Value = "$D$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args7())

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

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

rem ----------------------------------------------------------------------
dim args9(1) as new com.sun.star.beans.PropertyValue
args9(0).Name = "By"
args9(0).Value = 1
args9(1).Name = "Sel"
args9(1).Value = true

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args9())

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

rem ----------------------------------------------------------------------
dim args11(0) as new com.sun.star.beans.PropertyValue
args11(0).Name = "ToPoint"
args11(0).Value = "$E$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args11())

rem ----------------------------------------------------------------------
dim args12(5) as new com.sun.star.beans.PropertyValue
args12(0).Name = "Flags"
args12(0).Value = "SV"
args12(1).Name = "FormulaCommand"
args12(1).Value = 0
args12(2).Name = "SkipEmptyCells"
args12(2).Value = false
args12(3).Name = "Transpose"
args12(3).Value = false
args12(4).Name = "AsLink"
args12(4).Value = false
args12(5).Name = "MoveMode"
args12(5).Value = 4

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args12())


end sub


sub EUR
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 = true
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 = 1
args1(9).Name = "SearchItem.SearchFlags"
args1(9).Value = 65536
args1(10).Name = "SearchItem.SearchString"
args1(10).Value = "EUR"
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 = 3

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


end sub