von bredfeld » Mi, 21.03.2012 11:14
Jetzt meldet sich der Anfänger mal wieder mit seinem Ergebnis was sich mit hoher Sicherheit verbessern läßt. Im Moment kann ich nur einen Bereich farblich verändern, kopieren auf ein zweites Frame und dann wieder komplett Löschen.
Sub S_insert_color_and_copy_cell
nbackcolor = 65280
rem nbackcolor = 65280'44544
osel = thiscomponent.currentselection
if osel.CellBackColor <> nbackcolor then
osel.CellBackColor = nbackcolor 'hier mach ich grün
SourceCellAddress = osel.CellAddress 'Zeile ermitteln
SourceRangeAddress = osel.RangeAddress
nsheet = SourceCellAddress.sheet
TargetAddress = SourceCellAddress
TargetAddress.Sheet = nsheet+1
osheet = thiscomponent.sheets(nsheet)
osheet.copyRange(TargetAddress,SourceRangeAddress)
else osel.CellBackColor = -1
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "Nr"
args1(0).Value = 2
dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args1())
Doc = ThisComponent
Sheet = Doc.Sheets(1)
CellRange = Sheet.getCellRangeByName("A3:B5")
Flags = com.sun.star.sheet.CellFlags.STRING + com.sun.star.sheet.CellFlags.HARDATTR
CellRange.clearContents(Flags)
Sheet = ThisComponent.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 = "$A$3"
dispatcher.executeDispatch(Sheet, ".uno:GoToCell", "", 0, args2())
dispatcher.executeDispatch(Sheet, ".uno:ToggleMergeCells", "", 0, Array())
args1(0).Value = 1
dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args1())
end if
End Sub
Vielleicht kannst du mir ja noch einmal helfen ?
ciao e grazie Uwe
Jetzt meldet sich der Anfänger mal wieder mit seinem Ergebnis was sich mit hoher Sicherheit verbessern läßt. Im Moment kann ich nur einen Bereich farblich verändern, kopieren auf ein zweites Frame und dann wieder komplett Löschen.
Sub S_insert_color_and_copy_cell
nbackcolor = 65280
rem nbackcolor = 65280'44544
osel = thiscomponent.currentselection
if osel.CellBackColor <> nbackcolor then
osel.CellBackColor = nbackcolor 'hier mach ich grün
SourceCellAddress = osel.CellAddress 'Zeile ermitteln
SourceRangeAddress = osel.RangeAddress
nsheet = SourceCellAddress.sheet
TargetAddress = SourceCellAddress
TargetAddress.Sheet = nsheet+1
osheet = thiscomponent.sheets(nsheet)
osheet.copyRange(TargetAddress,SourceRangeAddress)
else osel.CellBackColor = -1
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "Nr"
args1(0).Value = 2
dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args1())
Doc = ThisComponent
Sheet = Doc.Sheets(1)
CellRange = Sheet.getCellRangeByName("A3:B5")
Flags = com.sun.star.sheet.CellFlags.STRING + com.sun.star.sheet.CellFlags.HARDATTR
CellRange.clearContents(Flags)
Sheet = ThisComponent.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 = "$A$3"
dispatcher.executeDispatch(Sheet, ".uno:GoToCell", "", 0, args2())
dispatcher.executeDispatch(Sheet, ".uno:ToggleMergeCells", "", 0, Array())
args1(0).Value = 1
dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args1())
end if
End Sub
Vielleicht kannst du mir ja noch einmal helfen ?
ciao e grazie Uwe