Bugzilla – Attachment 148855 Details for
Bug 123120
Bug: Calc fails to recalculate dependent cells
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
Macro code for spreadsheet
Module1.xba (text/html), 20.79 KB, created by
David Lynch
on 2019-02-02 08:51:22 UTC
(
hide
)
Description:
Macro code for spreadsheet
Filename:
MIME Type:
Creator:
David Lynch
Created:
2019-02-02 08:51:22 UTC
Size:
20.79 KB
patch
obsolete
><?xml version="1.0" encoding="UTF-8"?> ><!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> ><script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">global height, width as integer >'global height, width, topgap, leftgap as integer > >Sub Main >End Sub > > > >Function HideColumn(sheet as string, col as long, hidden as integer) as boolean >dim oSheet as object, oSheets as object, oColumn as object > >oSheets = ThisComponent.Sheets >oSheet = oSheets.getByName(sheet) >oColumn = oSheet.getColumns.getByIndex(col) >oColumn.IsVisible = (hidden = 0) >HideColumn = (hidden = 0) >End Function > > > >Private oListener as Object > >Private CellRng as Object > >Sub AddListener ' Tools->Customize -> Events menu to trigger the AddListener procedure on the Open Document event > ' and to trigger RmvListener on the Close Document Event >' Goto Exitpoint2 >Dim Doc, Sheet, Cell as Object > >Doc = ThisComponent >Sheet = Doc.Sheets.getByName("g") >CellRng = Sheet.getCellrangeByName("G1:G3") > >oListener = createUnoListener("Modify_","com.sun.star.util.XModifyListener") 'create a listener >Cellrng.addModifyListener(oListener) 'register the listener >Exitpoint2: >End Sub > >Sub Modify_modified(oEv) 'macro jumps here when oListener detects modification of Sheet >CalledRoutine >End Sub > >Sub Modify_disposing(oEv) >End Sub > >Sub RmvListener >' CellRng.removeModify_Listener(oListener) >End Sub > >Sub CalledRoutine > > dim oRange ' named range > dim oRanges ' All named ranges. > oRanges = ThisComponent.NamedRanges > oRange = ThisComponent.NamedRanges.getByName("width") > oW = oRange.getReferredCells() > oRange = ThisComponent.NamedRanges.getByName("height") > oH = oRange.getReferredCells() > > dim oCell ' Cell object. > ' get width > oCell = oW.getCellByPosition(0,0) > dim width as integer > width = oCell.getString() > > oCell = oH.getCellByPosition(0,0) > ' dim height as integer > height = cInt(oCell.getString()) > > ' Format $w > ' Merge a range of cells >' dim oSheetw, oSheets, oCursw, oRangew >' dim topgap, leftgap as integer > > ' oSheets = ThisComponent.Sheets > ' oSheetw = oSheets.getByName("w") > >' oRange = ThisComponent.NamedRanges.getByName("topgap") >' oT = oRange.getReferredCells() >' oCell = oT.getCellByPosition(0,0) > ' topgap = oCell.getString() > >' oRange = ThisComponent.NamedRanges.getByName("leftgap") >' oT = oRange.getReferredCells() >' oCell = oT.getCellByPosition(0,0) >' leftgap = oCell.getString() > > ' Clear existing merged cells >' dim oRangex, oRangey >' oRangex = oSheetw.getCellRangeByName("A1:AZ100") >' oRangex.merge(False) > > ' Create new merged area >' oCursw = oSheetw.createCursorByRange(oSheetw.getCellRangeByPosition(leftgap-1,topgap,leftgap+31,topgap+64)) > >' for column = 0 to width - 1 >' for row = 0 to height - 1 >' oRangey = oCursw.getCellRangeByPosition(column, row * 2, column, row * 2 + 1) > ' oRangey.merge(True) >' Next > ' Next > > ' Set columns to correct width >' dim A2cell, oRangez, A2Size, oColumnsz > ' dim cellsize as Long >' A2cell = osheetw.getCellByPosition(0,1) > ' A2Size = A2cell.Size >' cellsize = A2Size.Height > ' Double width columns >' oRangez = oSheetw.getCellRangeByPosition(leftgap-1,0,leftgap+width,0) >' oColumnsz = oRangez.getColumns() >' oColumnsz.Width = cellsize * 2 > ' Single width columns >' oRangez = oSheetw.getCellRangeByPosition(leftgap+width,0,leftgap+133,0) > ' oColumnsz = oRangez.getColumns() >' oColumnsz.Width = cellsize > ' Rewrite input area >' dim oSheetfw, oCursorfw, oCursorw, oArray >' oSheetfw = oSheets.getByName("fw") >' oCursorfw = oSheetfw.createCursorByRange(oSheetfw.getCellRangeByPosition(0,0,31,31)) >' oArray = oCursorfw.getFormulaArray() >' oCursorw = oSheetw.createCursorByRange(oSheetw.getCellRangeByPosition(leftgap-1,0,leftgap+30,31)) > ' oCursorw.setFormulaArray(oArray) > > ' Format $x > ' Merge a range of cells >' dim osheets > dim oSheetx, oCursx, oRanger > dim xtoprow as integer > > oSheets = ThisComponent.Sheets > oSheetx = oSheets.getByName("x") > > oRanger = ThisComponent.NamedRanges.getByName("xtoprow") > oT = oRanger.getReferredCells() > oCell = oT.getCellByPosition(0,0) > xtoprow = oCell.getString() > > ' oRange = ThisComponent.NamedRanges.getByName("leftgap") > ' oT = oRange.getReferredCells() >' oCell = oT.getCellByPosition(0,0) > ' leftgap = oCell.getString() > > ' Clear existing merged cells > ' dim oRangex, oRangey >' oSheetg = oSheets.getByName("g") > '' oCursorg = oSheetg.createCursorByRange(oSheetg.getCellRangeByPosition(8,5,8+31,5+31)) > ' Flags = 23 >' oCursorg.clearContents(Flags) >' oCursorg.CellStyle = "Default" > oRangex = oSheetx.getCellRangeByName("AA1:BF100") > oRangex.merge(False) > oRangex.clearContents(23) > oRangex.CellStyle = "Default" > > ' Create new merged area > oCursx = oSheetx.createCursorByRange(oSheetx.getCellRangeByPosition(26,xtoprow,26+31,xtoprow+64)) > for column = 0 to width - 1 > for row = 0 to height - 1 > oRangey = oCursx.getCellRangeByPosition(column, row * 2, column, row * 2 + 1) > oRangey.merge(True) > Next > Next > > ' Set columns to correct width > ' dim A2cell, oRangez, A2Size, oColumnsz > ' dim cellsize as Long >' A2cell = osheetx.getCellByPosition(0,1) > ' A2Size = A2cell.Size > ' cellsize = A2Size.Height > ' Double width columns > ' oRangez = oSheetx.getCellRangeByPosition(xtoprow-1,0,xtoprow+width,0) > ' oColumnsz = oRangez.getColumns() > ' oColumnsz.Width = cellsize * 2 > ' Single width columns >'' oRangez = oSheetw.getCellRangeByPosition(leftgap+width,0,leftgap+133,0) > ' oColumnsz = oRangez.getColumns() > ' oColumnsz.Width = cellsize > ' Rewrite input area > dim oSheetxw, oCursorxw, oCursorx2, oArrayxw > oSheetxw = oSheets.getByName("xw") > oCursorxw = oSheetxw.createCursorByRange(oSheetxw.getCellRangeByPosition(0,0,31,63)) > oArrayxw = oCursorxw.getFormulaArray() > oCursorx2 = oSheetx.createCursorByRange(oSheetx.getCellRangeByPosition(26,xtoprow,26+31,xtoprow+63)) > oCursorx2.setFormulaArray(oArrayxw) > ' Set input area (for mode 3) > dim mode as integer > oRanger = ThisComponent.NamedRanges.getByName("mode") > oT = oRanger.getReferredCells() > oCell = oT.getCellByPosition(0,0) > mode = oCell.getString() > > If mode = 3 then > dim oRangex3 > oRangex3 = oSheetx.getCellRangeByPosition(26,0,26+width-1,height-1) > oRangex3.CellStyle = "input" > End if > > ' Format $g > ' Clear input & result areas > dim oSheetg, oCursorg, oRangeg, oArrayg > dim Flags as integer > > oSheetg = oSheets.getByName("g") > oCursorg = oSheetg.createCursorByRange(oSheetg.getCellRangeByPosition(8,5,8+31,5+31)) > Flags = 23 > oCursorg.clearContents(Flags) > oCursorg.CellStyle = "Default" > > ' Set input area > oRangeg = oCursorg.getCellRangeByPosition(0,0,width-1,height-1) > oRangeg.CellStyle = "input" > > ' Set result area > dim oSheetfg, oCursorfg, oArrayfg > oSheetfg = oSheets.getByName("fg") > oCursorfg = oSheetfg.createCursorByRange(oSheetfg.getCellRangeByPosition(0,0,width,height)) > oArrayfg = oCursorfg.getFormulaArray() > oCursorfg = oSheetg.createCursorByRange(oSheetg.getCellRangeByPosition(8,5+height+1,8+width,5+2*height+1)) > oCursorfg.setFormulaArray(oArrayfg) >Exitpoint: > >End Sub > >Function quad(nwd,ned,swd,sed,nwa,nea,swa,sea) as String > >quad= "" >For wd = 1 to len(nwd) > For na = 1 to len(nwa) > If mid(nwd,wd,1) = mid(nwa,na,1) Then ' nw cell > For ed = 1 to len(ned) > If mid(nea,na,1) = mid(ned,ed,1) Then ' ne cell > For sa = 1 to len(sea) > If mid(sed,ed,1) = mid(sea,sa,1) Then ' se cell > If mid(swa,sa,1) = mid(swd,wd,1) Then ' sw cell > quad = quad & mid(nwd,wd,1) & mid(nea,na,1) & mid(sed,ed,1) & mid(swd,wd,1) > End If > End If > Next > End If > Next > End If > Next >Next >End Function > >function doBorder (b as integer) as object > dim oBorder > oBorder = CreateUnoStruct("com.sun.star.table.BorderLine") > select case b > case 0 > ' undefined, do nothing > case 1 > oBorder.OuterLineWidth = 0 > case 2 > oBorder.OuterLineWidth = 35 > oBorder.Color = RGB(0,0,0) ' black > case 3 > oBorder.OuterLineWidth = 60 > oBorder.Color = RGB(192,192,192) ' grey > case 4 > oBorder.OuterLineWidth = 60 > oBorder.Color = RGB(0,0,0) ' black > end select > doBorder = oBorder >end function > >private oListenerw, oListenerb as object >private CellRngw, CellRngb as object > >sub AddListenerw ' Tools->Customize -> Events menu to trigger the AddListener procedure on the Open Document event > ' and to trigger RmvListener on the Close Document Event > dim Doc as object > > Doc = ThisComponent > CellRngw = Doc.NamedRanges.getByName("wh").ReferredCells > oListenerw = createUnoListener("Modifyw_","com.sun.star.util.XModifyListener") 'create a listener > CellRngw.addModifyListener(oListenerw) 'register the listener > > dim CellRnggp as object > CellRnggp = Doc.NamedRanges.getByName("grid_par").ReferredCells > CellRngb = CellRnggp.getCellRangeByPosition(6,0,6,511) ' hash column > > oListenerb = createUnoListener("Modifyb_","com.sun.star.util.XModifyListener") 'create a listener > CellRngb.addModifyListener(oListenerb) 'register the listener > >End Sub > >Sub Modifyb_modified(oEv) 'macro jumps here when oListener detects modification of Sheet > CalledRoutineb >End Sub > >Sub Modifyb_disposing(oEv) >End Sub > >Sub RmvListenerb > CellRngb.removeModifyListener(oListenerb) >End Sub > >Sub Modifyw_modified(oEv) 'macro jumps here when oListener detects modification of Sheet > CalledRoutinew >End Sub > >Sub Modifyw_disposing(oEv) >End Sub > >Sub RmvListenerw >' CellRngw.removeModifyListener(oListenerw) >End Sub > >Sub CalledRoutinew > > dim oRange ' named range > dim oRanges ' All named ranges. > dim Doc as object > Doc = ThisComponent > oRanges = Doc.NamedRanges > oRange = Doc.NamedRanges.getByName("width") > oW = oRange.getReferredCells() > oRange = Doc.NamedRanges.getByName("height") > oH = oRange.getReferredCells() > > dim oCell ' Cell object. > ' get width > oCell = oW.getCellByPosition(0,0) >' dim width as integer > width = cInt(oCell.getString()) > > oCell = oH.getCellByPosition(0,0) > ' dim height as integer > height = cInt(oCell.getString()) > > ' Format $w > ' Merge a range of cells > dim oSheetw, oSheets, oCursw, oRangew >' dim topgap, leftgap as integer > >' oSheets = ThisComponent.Sheets >' oSheetw = oSheets.getByName("w") > >' oRange = ThisComponent.NamedRanges.getByName("topgap") >' oT = oRange.getReferredCells() >' oCell = oT.getCellByPosition(0,0) >' topgap = cInt(oCell.getString()) > >' oRange = ThisComponent.NamedRanges.getByName("leftgap") >' oT = oRange.getReferredCells() >' oCell = oT.getCellByPosition(0,0) >' leftgap = cInt(oCell.getString()) > > ' demerge existing merged cells >' dim oRangex, oRangey >' oRangex = oSheetw.getCellRangeByName("A1:AZ100") >' oRangex.merge(False) > > ' clear all grids area >' dim Flags as integer >' oCursorw = oSheetw.createCursorByRange(oSheetw.getCellRangeByPosition(leftgap-1,0,leftgap+130,65)) >' Flags = 23 + 96 >' oCursorw.clearContents(Flags) >' oCursorw.CellStyle = "grids" > > ' Create new merged area >' oCursw = oSheetw.createCursorByRange(oSheetw.getCellRangeByPosition(leftgap-1,topgap,leftgap+31,topgap+64)) > >' for column = 0 to width - 1 > ' for row = 0 to height - 1 > ' oRangey = oCursw.getCellRangeByPosition(column, row * 2, column, row * 2 + 1) > ' oRangey.merge(True) > ' Next > ' Next > > ' Set columns to correct width >' dim A2cell, oRangez, A2Size, oColumnsz >' dim cellsize as Long >' A2cell = osheetw.getCellByPosition(0,1) >' A2Size = A2cell.Size >' cellsize = A2Size.Height > ' Double width columns >' oRangez = oSheetw.getCellRangeByPosition(leftgap-1,0,leftgap+width,0) >' oColumnsz = oRangez.getColumns() >' oColumnsz.Width = cellsize * 2 > ' Single width columns >' oRangez = oSheetw.getCellRangeByPosition(leftgap+width,0,leftgap+133,0) >' oColumnsz = oRangez.getColumns() >' oColumnsz.Width = cellsize > > ' Format $g > ' Clear input & result areas > dim oSheetg, oCursorg, oRangeg, oArrayg > > > oSheetg = oSheets.getByName("g") > oCursorg = oSheetg.createCursorByRange(oSheetg.getCellRangeByPosition(8,5,8+31,5+31)) > Flags = 23 + 96 > oCursorg.clearContents(Flags) > oCursorg.CellStyle = "Default" > ' Set input area > oRangeg = oCursorg.getCellRangeByPosition(0,0,width-1,height-1) > oRangeg.CellStyle = "input" > > oRangegp = Doc.NamedRanges.getByName("grid_par").ReferredCells > oCursorg = oRangegp.getCellRangeByPosition(7,0,7,511) ' shadow > Flags = 23 + 96 > oCursorg.clearContents(Flags) > oCursorg.CellStyle = "Default" > >End Sub > >sub CalledRoutineb > > dim Doc, oRangegp as object > Doc = ThisComponent > oRangegp = Doc.NamedRanges.getByName("grid_par").ReferredCells > > dim oSheetg, osheetw as object > dim oRangeg as object ' format, number, no entry > oSheetg = Doc.Sheets.getByName("g") > > oRangeg = oSheetg.getCellRangeByPosition(8,5,8+width-1,5+height-1) > dim oRangeb as object ' big, border, number, entry >' oSheetw = Doc.Sheets.getByName("w") >' oRangeb = oSheetw.getCellRangeByPosition(leftgap-1,topgap,leftgap+width,topgap+height*2) >' dim oRanges1 as object ' border, number, entry >' oRanges1 = oSheetw.getCellRangeByPosition(leftgap+width,0,leftgap+width*2-1,height-1) >' dim oRanges2 as object ' border, entry >' oRanges2 = oSheetw.getCellRangeByPosition(leftgap+width*2+1,0,leftgap+width*3,height-1) >' dim oRanges3 as object ' entry >' oRanges3 = oSheetw.getCellRangeByPosition(leftgap+width*3+2,0,leftgap+width*4+1,height-1) > >' dim iRow, iCol, iPos as integer >' iPos = 0 >' for iRow = 0 to height - 1 >' for iCol = 0 to width - 1 > >' dim oCellHash,oCellShadow as object >' dim Hash as string >' oCellHash = oRangegp.getCellByPosition(6,iPos) ' hash >' Hash = oCellHash.getString() >' oCellShadow = oRangegp.getCellByPosition(7,iPos) ' shadow >' dim change as boolean >' if oCellShadow.Type = com.sun.star.table.CellContentType.EMPTY then >' change = True >' else >' change = (oCellShadow.getString() <> Hash) >' end if >' >' if change then ' cell has changed >' >' oCellShadow.String = Hash >' ' cells for updating >' dim oCellg, oCellb, oCells1, oCells2, oCells3 as object >' oCellg = oRangeg.getCellByPosition(iCol,iRow) >' oCellb = oRangeb.getCellByPosition(iCol,iRow*2) >' oCells1 = oRanges1.getCellByPosition(iCol,iRow) >' oCells2 = oRanges2.getCellByPosition(iCol,iRow) >' oCells3 = oRanges3.getCellByPosition(iCol,iRow) >' >' ' borders >' dim bl, bt, br, bb as integer >' bl = cInt(oRangegp.getCellByPosition(0,iPos).getString()) >' bt = cInt(oRangegp.getCellByPosition(1,iPos).getString()) >' br = cInt(oRangegp.getCellByPosition(2,iPos).getString()) >' bb = cInt(oRangegp.getCellByPosition(3,iPos).getString()) >' >' oCellg.LeftBorder = doBorder(bl) >' oCellg.TopBorder = doBorder(bt) >' oCellg.RightBorder = doBorder(br) >' oCellg.BottomBorder = doBorder(bb) >' >' oCellb.LeftBorder = doBorder(bl) >' oCellb.TopBorder = doBorder(bt) >' oCellb.RightBorder = doBorder(br) >' oCellb.BottomBorder = doBorder(bb) >' >' oCells1.LeftBorder = doBorder(bl) >' oCells1.TopBorder = doBorder(bt) >'' oCells1.RightBorder = doBorder(br) >' oCells1.BottomBorder = doBorder(bb) >' >' oCells2.LeftBorder = doBorder(bl) >' oCells2.TopBorder = doBorder(bt) >' oCells2.RightBorder = doBorder(br) >' oCells2.BottomBorder = doBorder(bb) >' ' shrink >' oCellg.ShrinkToFit = True >' oCellb.ShrinkToFit = True >' oCells1.ShrinkToFit = True >' oCells2.ShrinkToFit = True >' oCells3.ShrinkToFit = True >' ' clue number >' dim Cluen as string >' dim lenn as integer >' Cluen = oRangegp.getCellByPosition(4,iPos).getString() >' lenn = len(Cluen) >' ' entry >' dim Entry as string >' dim lene as integer >' Entry = oRangegp.getCellByPosition(5,iPos).getString() >' lene = len(Entry) >' ' fill cells >' oCellg.String = Cluen >' oCellb.String = Cluen + Entry >' oCells1.String = Cluen + Entry >' oCells2.String = Entry >' oCells3.String = Entry >' ' justification >' oCellg.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT >' oCells2.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER >' oCells3.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER >' ' clue number >'' if lenn = 0 then ' no clue number >' oCellb.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER >' oCells1.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER >' else ' single or double digit >' oCellb.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT >' oCells1.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT >' ' superscript >' dim oCursg as object >' oCursg = oCellg.getText().createTextCursor() >' oCursg.gotoStart(False) >' oCursg.goRight(lenn, True) >' oCursg.CharEscapementHeight = 50 >' oCursg.CharEscapement = 60 >' >' dim oCursb as object >' oCursb = oCellb.getText().createTextCursor() >' oCursb.gotoStart(False) >' oCursb.goRight(lenn, True) >' oCursb.CharEscapementHeight = 50 >' oCursb.CharEscapement = 60 >' >' dim oCurss1 as object >' oCurss1 = oCells1.getText().createTextCursor() >' oCurss1.gotoStart(False) >' oCurss1.goRight(lenn, True) >' oCurss1.CharEscapementHeight = 50 >' oCurss1.CharEscapement = CInt(oRangegp.getCellByPosition(11,iPos).getString()) >' >' if lene = 1 then ' compress or expand text >' ' kerning >' ' expand >' dim Kernb as integer >' Kernb = CInt(oRangegp.getCellByPosition(10,iPos).getString()) >' if Kernb > 0 then >' oCursb = oCellb.getText().createTextCursor() >' oCursb.gotoStart(False) >' oCursb.goRight(lenn - 1, False) >' oCursb.goRight(1, True) >' oCursb.CharAutoKerning = True >' oCursb.CharKerning = Kernb >' end if >' oCursb.CharAutoKerning = True >' oCursb.CharKerning = bKern >' dim Kerns as integer >'' Kerns = CInt(oRangegp.getCellByPosition(9,iPos).getString()) >' if Kerns > 0 then 'expand >' oCurss1 = oCells1.getText().createTextCursor() >' oCurss1.gotoStart(False) >' oCurss1.goRight(lenn - 1, False) >' oCurss1.goRight(1, True) >' oCurss1.CharAutoKerning = True >' oCurss1.CharKerning = Kerns >' else ' condense >' dim Conds as integer >' Conds = CInt(oRangegp.getCellByPosition(8,iPos).getString()) >' if sCond <> 100 then >' oCurss.CharScaleWidth = Conds >' end if >' end if >' end if >' end if >' end if >' iPos = iPos + 1 >' next >' next >' >End Sub ></script:module>
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Module1" script:language="StarBasic">global height, width as integer 'global height, width, topgap, leftgap as integer Sub Main End Sub Function HideColumn(sheet as string, col as long, hidden as integer) as boolean dim oSheet as object, oSheets as object, oColumn as object oSheets = ThisComponent.Sheets oSheet = oSheets.getByName(sheet) oColumn = oSheet.getColumns.getByIndex(col) oColumn.IsVisible = (hidden = 0) HideColumn = (hidden = 0) End Function Private oListener as Object Private CellRng as Object Sub AddListener ' Tools->Customize -> Events menu to trigger the AddListener procedure on the Open Document event ' and to trigger RmvListener on the Close Document Event ' Goto Exitpoint2 Dim Doc, Sheet, Cell as Object Doc = ThisComponent Sheet = Doc.Sheets.getByName("g") CellRng = Sheet.getCellrangeByName("G1:G3") oListener = createUnoListener("Modify_","com.sun.star.util.XModifyListener") 'create a listener Cellrng.addModifyListener(oListener) 'register the listener Exitpoint2: End Sub Sub Modify_modified(oEv) 'macro jumps here when oListener detects modification of Sheet CalledRoutine End Sub Sub Modify_disposing(oEv) End Sub Sub RmvListener ' CellRng.removeModify_Listener(oListener) End Sub Sub CalledRoutine dim oRange ' named range dim oRanges ' All named ranges. oRanges = ThisComponent.NamedRanges oRange = ThisComponent.NamedRanges.getByName("width") oW = oRange.getReferredCells() oRange = ThisComponent.NamedRanges.getByName("height") oH = oRange.getReferredCells() dim oCell ' Cell object. ' get width oCell = oW.getCellByPosition(0,0) dim width as integer width = oCell.getString() oCell = oH.getCellByPosition(0,0) ' dim height as integer height = cInt(oCell.getString()) ' Format $w ' Merge a range of cells ' dim oSheetw, oSheets, oCursw, oRangew ' dim topgap, leftgap as integer ' oSheets = ThisComponent.Sheets ' oSheetw = oSheets.getByName("w") ' oRange = ThisComponent.NamedRanges.getByName("topgap") ' oT = oRange.getReferredCells() ' oCell = oT.getCellByPosition(0,0) ' topgap = oCell.getString() ' oRange = ThisComponent.NamedRanges.getByName("leftgap") ' oT = oRange.getReferredCells() ' oCell = oT.getCellByPosition(0,0) ' leftgap = oCell.getString() ' Clear existing merged cells ' dim oRangex, oRangey ' oRangex = oSheetw.getCellRangeByName("A1:AZ100") ' oRangex.merge(False) ' Create new merged area ' oCursw = oSheetw.createCursorByRange(oSheetw.getCellRangeByPosition(leftgap-1,topgap,leftgap+31,topgap+64)) ' for column = 0 to width - 1 ' for row = 0 to height - 1 ' oRangey = oCursw.getCellRangeByPosition(column, row * 2, column, row * 2 + 1) ' oRangey.merge(True) ' Next ' Next ' Set columns to correct width ' dim A2cell, oRangez, A2Size, oColumnsz ' dim cellsize as Long ' A2cell = osheetw.getCellByPosition(0,1) ' A2Size = A2cell.Size ' cellsize = A2Size.Height ' Double width columns ' oRangez = oSheetw.getCellRangeByPosition(leftgap-1,0,leftgap+width,0) ' oColumnsz = oRangez.getColumns() ' oColumnsz.Width = cellsize * 2 ' Single width columns ' oRangez = oSheetw.getCellRangeByPosition(leftgap+width,0,leftgap+133,0) ' oColumnsz = oRangez.getColumns() ' oColumnsz.Width = cellsize ' Rewrite input area ' dim oSheetfw, oCursorfw, oCursorw, oArray ' oSheetfw = oSheets.getByName("fw") ' oCursorfw = oSheetfw.createCursorByRange(oSheetfw.getCellRangeByPosition(0,0,31,31)) ' oArray = oCursorfw.getFormulaArray() ' oCursorw = oSheetw.createCursorByRange(oSheetw.getCellRangeByPosition(leftgap-1,0,leftgap+30,31)) ' oCursorw.setFormulaArray(oArray) ' Format $x ' Merge a range of cells ' dim osheets dim oSheetx, oCursx, oRanger dim xtoprow as integer oSheets = ThisComponent.Sheets oSheetx = oSheets.getByName("x") oRanger = ThisComponent.NamedRanges.getByName("xtoprow") oT = oRanger.getReferredCells() oCell = oT.getCellByPosition(0,0) xtoprow = oCell.getString() ' oRange = ThisComponent.NamedRanges.getByName("leftgap") ' oT = oRange.getReferredCells() ' oCell = oT.getCellByPosition(0,0) ' leftgap = oCell.getString() ' Clear existing merged cells ' dim oRangex, oRangey ' oSheetg = oSheets.getByName("g") '' oCursorg = oSheetg.createCursorByRange(oSheetg.getCellRangeByPosition(8,5,8+31,5+31)) ' Flags = 23 ' oCursorg.clearContents(Flags) ' oCursorg.CellStyle = "Default" oRangex = oSheetx.getCellRangeByName("AA1:BF100") oRangex.merge(False) oRangex.clearContents(23) oRangex.CellStyle = "Default" ' Create new merged area oCursx = oSheetx.createCursorByRange(oSheetx.getCellRangeByPosition(26,xtoprow,26+31,xtoprow+64)) for column = 0 to width - 1 for row = 0 to height - 1 oRangey = oCursx.getCellRangeByPosition(column, row * 2, column, row * 2 + 1) oRangey.merge(True) Next Next ' Set columns to correct width ' dim A2cell, oRangez, A2Size, oColumnsz ' dim cellsize as Long ' A2cell = osheetx.getCellByPosition(0,1) ' A2Size = A2cell.Size ' cellsize = A2Size.Height ' Double width columns ' oRangez = oSheetx.getCellRangeByPosition(xtoprow-1,0,xtoprow+width,0) ' oColumnsz = oRangez.getColumns() ' oColumnsz.Width = cellsize * 2 ' Single width columns '' oRangez = oSheetw.getCellRangeByPosition(leftgap+width,0,leftgap+133,0) ' oColumnsz = oRangez.getColumns() ' oColumnsz.Width = cellsize ' Rewrite input area dim oSheetxw, oCursorxw, oCursorx2, oArrayxw oSheetxw = oSheets.getByName("xw") oCursorxw = oSheetxw.createCursorByRange(oSheetxw.getCellRangeByPosition(0,0,31,63)) oArrayxw = oCursorxw.getFormulaArray() oCursorx2 = oSheetx.createCursorByRange(oSheetx.getCellRangeByPosition(26,xtoprow,26+31,xtoprow+63)) oCursorx2.setFormulaArray(oArrayxw) ' Set input area (for mode 3) dim mode as integer oRanger = ThisComponent.NamedRanges.getByName("mode") oT = oRanger.getReferredCells() oCell = oT.getCellByPosition(0,0) mode = oCell.getString() If mode = 3 then dim oRangex3 oRangex3 = oSheetx.getCellRangeByPosition(26,0,26+width-1,height-1) oRangex3.CellStyle = "input" End if ' Format $g ' Clear input & result areas dim oSheetg, oCursorg, oRangeg, oArrayg dim Flags as integer oSheetg = oSheets.getByName("g") oCursorg = oSheetg.createCursorByRange(oSheetg.getCellRangeByPosition(8,5,8+31,5+31)) Flags = 23 oCursorg.clearContents(Flags) oCursorg.CellStyle = "Default" ' Set input area oRangeg = oCursorg.getCellRangeByPosition(0,0,width-1,height-1) oRangeg.CellStyle = "input" ' Set result area dim oSheetfg, oCursorfg, oArrayfg oSheetfg = oSheets.getByName("fg") oCursorfg = oSheetfg.createCursorByRange(oSheetfg.getCellRangeByPosition(0,0,width,height)) oArrayfg = oCursorfg.getFormulaArray() oCursorfg = oSheetg.createCursorByRange(oSheetg.getCellRangeByPosition(8,5+height+1,8+width,5+2*height+1)) oCursorfg.setFormulaArray(oArrayfg) Exitpoint: End Sub Function quad(nwd,ned,swd,sed,nwa,nea,swa,sea) as String quad= "" For wd = 1 to len(nwd) For na = 1 to len(nwa) If mid(nwd,wd,1) = mid(nwa,na,1) Then ' nw cell For ed = 1 to len(ned) If mid(nea,na,1) = mid(ned,ed,1) Then ' ne cell For sa = 1 to len(sea) If mid(sed,ed,1) = mid(sea,sa,1) Then ' se cell If mid(swa,sa,1) = mid(swd,wd,1) Then ' sw cell quad = quad & mid(nwd,wd,1) & mid(nea,na,1) & mid(sed,ed,1) & mid(swd,wd,1) End If End If Next End If Next End If Next Next End Function function doBorder (b as integer) as object dim oBorder oBorder = CreateUnoStruct("com.sun.star.table.BorderLine") select case b case 0 ' undefined, do nothing case 1 oBorder.OuterLineWidth = 0 case 2 oBorder.OuterLineWidth = 35 oBorder.Color = RGB(0,0,0) ' black case 3 oBorder.OuterLineWidth = 60 oBorder.Color = RGB(192,192,192) ' grey case 4 oBorder.OuterLineWidth = 60 oBorder.Color = RGB(0,0,0) ' black end select doBorder = oBorder end function private oListenerw, oListenerb as object private CellRngw, CellRngb as object sub AddListenerw ' Tools->Customize -> Events menu to trigger the AddListener procedure on the Open Document event ' and to trigger RmvListener on the Close Document Event dim Doc as object Doc = ThisComponent CellRngw = Doc.NamedRanges.getByName("wh").ReferredCells oListenerw = createUnoListener("Modifyw_","com.sun.star.util.XModifyListener") 'create a listener CellRngw.addModifyListener(oListenerw) 'register the listener dim CellRnggp as object CellRnggp = Doc.NamedRanges.getByName("grid_par").ReferredCells CellRngb = CellRnggp.getCellRangeByPosition(6,0,6,511) ' hash column oListenerb = createUnoListener("Modifyb_","com.sun.star.util.XModifyListener") 'create a listener CellRngb.addModifyListener(oListenerb) 'register the listener End Sub Sub Modifyb_modified(oEv) 'macro jumps here when oListener detects modification of Sheet CalledRoutineb End Sub Sub Modifyb_disposing(oEv) End Sub Sub RmvListenerb CellRngb.removeModifyListener(oListenerb) End Sub Sub Modifyw_modified(oEv) 'macro jumps here when oListener detects modification of Sheet CalledRoutinew End Sub Sub Modifyw_disposing(oEv) End Sub Sub RmvListenerw ' CellRngw.removeModifyListener(oListenerw) End Sub Sub CalledRoutinew dim oRange ' named range dim oRanges ' All named ranges. dim Doc as object Doc = ThisComponent oRanges = Doc.NamedRanges oRange = Doc.NamedRanges.getByName("width") oW = oRange.getReferredCells() oRange = Doc.NamedRanges.getByName("height") oH = oRange.getReferredCells() dim oCell ' Cell object. ' get width oCell = oW.getCellByPosition(0,0) ' dim width as integer width = cInt(oCell.getString()) oCell = oH.getCellByPosition(0,0) ' dim height as integer height = cInt(oCell.getString()) ' Format $w ' Merge a range of cells dim oSheetw, oSheets, oCursw, oRangew ' dim topgap, leftgap as integer ' oSheets = ThisComponent.Sheets ' oSheetw = oSheets.getByName("w") ' oRange = ThisComponent.NamedRanges.getByName("topgap") ' oT = oRange.getReferredCells() ' oCell = oT.getCellByPosition(0,0) ' topgap = cInt(oCell.getString()) ' oRange = ThisComponent.NamedRanges.getByName("leftgap") ' oT = oRange.getReferredCells() ' oCell = oT.getCellByPosition(0,0) ' leftgap = cInt(oCell.getString()) ' demerge existing merged cells ' dim oRangex, oRangey ' oRangex = oSheetw.getCellRangeByName("A1:AZ100") ' oRangex.merge(False) ' clear all grids area ' dim Flags as integer ' oCursorw = oSheetw.createCursorByRange(oSheetw.getCellRangeByPosition(leftgap-1,0,leftgap+130,65)) ' Flags = 23 + 96 ' oCursorw.clearContents(Flags) ' oCursorw.CellStyle = "grids" ' Create new merged area ' oCursw = oSheetw.createCursorByRange(oSheetw.getCellRangeByPosition(leftgap-1,topgap,leftgap+31,topgap+64)) ' for column = 0 to width - 1 ' for row = 0 to height - 1 ' oRangey = oCursw.getCellRangeByPosition(column, row * 2, column, row * 2 + 1) ' oRangey.merge(True) ' Next ' Next ' Set columns to correct width ' dim A2cell, oRangez, A2Size, oColumnsz ' dim cellsize as Long ' A2cell = osheetw.getCellByPosition(0,1) ' A2Size = A2cell.Size ' cellsize = A2Size.Height ' Double width columns ' oRangez = oSheetw.getCellRangeByPosition(leftgap-1,0,leftgap+width,0) ' oColumnsz = oRangez.getColumns() ' oColumnsz.Width = cellsize * 2 ' Single width columns ' oRangez = oSheetw.getCellRangeByPosition(leftgap+width,0,leftgap+133,0) ' oColumnsz = oRangez.getColumns() ' oColumnsz.Width = cellsize ' Format $g ' Clear input & result areas dim oSheetg, oCursorg, oRangeg, oArrayg oSheetg = oSheets.getByName("g") oCursorg = oSheetg.createCursorByRange(oSheetg.getCellRangeByPosition(8,5,8+31,5+31)) Flags = 23 + 96 oCursorg.clearContents(Flags) oCursorg.CellStyle = "Default" ' Set input area oRangeg = oCursorg.getCellRangeByPosition(0,0,width-1,height-1) oRangeg.CellStyle = "input" oRangegp = Doc.NamedRanges.getByName("grid_par").ReferredCells oCursorg = oRangegp.getCellRangeByPosition(7,0,7,511) ' shadow Flags = 23 + 96 oCursorg.clearContents(Flags) oCursorg.CellStyle = "Default" End Sub sub CalledRoutineb dim Doc, oRangegp as object Doc = ThisComponent oRangegp = Doc.NamedRanges.getByName("grid_par").ReferredCells dim oSheetg, osheetw as object dim oRangeg as object ' format, number, no entry oSheetg = Doc.Sheets.getByName("g") oRangeg = oSheetg.getCellRangeByPosition(8,5,8+width-1,5+height-1) dim oRangeb as object ' big, border, number, entry ' oSheetw = Doc.Sheets.getByName("w") ' oRangeb = oSheetw.getCellRangeByPosition(leftgap-1,topgap,leftgap+width,topgap+height*2) ' dim oRanges1 as object ' border, number, entry ' oRanges1 = oSheetw.getCellRangeByPosition(leftgap+width,0,leftgap+width*2-1,height-1) ' dim oRanges2 as object ' border, entry ' oRanges2 = oSheetw.getCellRangeByPosition(leftgap+width*2+1,0,leftgap+width*3,height-1) ' dim oRanges3 as object ' entry ' oRanges3 = oSheetw.getCellRangeByPosition(leftgap+width*3+2,0,leftgap+width*4+1,height-1) ' dim iRow, iCol, iPos as integer ' iPos = 0 ' for iRow = 0 to height - 1 ' for iCol = 0 to width - 1 ' dim oCellHash,oCellShadow as object ' dim Hash as string ' oCellHash = oRangegp.getCellByPosition(6,iPos) ' hash ' Hash = oCellHash.getString() ' oCellShadow = oRangegp.getCellByPosition(7,iPos) ' shadow ' dim change as boolean ' if oCellShadow.Type = com.sun.star.table.CellContentType.EMPTY then ' change = True ' else ' change = (oCellShadow.getString() <> Hash) ' end if ' ' if change then ' cell has changed ' ' oCellShadow.String = Hash ' ' cells for updating ' dim oCellg, oCellb, oCells1, oCells2, oCells3 as object ' oCellg = oRangeg.getCellByPosition(iCol,iRow) ' oCellb = oRangeb.getCellByPosition(iCol,iRow*2) ' oCells1 = oRanges1.getCellByPosition(iCol,iRow) ' oCells2 = oRanges2.getCellByPosition(iCol,iRow) ' oCells3 = oRanges3.getCellByPosition(iCol,iRow) ' ' ' borders ' dim bl, bt, br, bb as integer ' bl = cInt(oRangegp.getCellByPosition(0,iPos).getString()) ' bt = cInt(oRangegp.getCellByPosition(1,iPos).getString()) ' br = cInt(oRangegp.getCellByPosition(2,iPos).getString()) ' bb = cInt(oRangegp.getCellByPosition(3,iPos).getString()) ' ' oCellg.LeftBorder = doBorder(bl) ' oCellg.TopBorder = doBorder(bt) ' oCellg.RightBorder = doBorder(br) ' oCellg.BottomBorder = doBorder(bb) ' ' oCellb.LeftBorder = doBorder(bl) ' oCellb.TopBorder = doBorder(bt) ' oCellb.RightBorder = doBorder(br) ' oCellb.BottomBorder = doBorder(bb) ' ' oCells1.LeftBorder = doBorder(bl) ' oCells1.TopBorder = doBorder(bt) '' oCells1.RightBorder = doBorder(br) ' oCells1.BottomBorder = doBorder(bb) ' ' oCells2.LeftBorder = doBorder(bl) ' oCells2.TopBorder = doBorder(bt) ' oCells2.RightBorder = doBorder(br) ' oCells2.BottomBorder = doBorder(bb) ' ' shrink ' oCellg.ShrinkToFit = True ' oCellb.ShrinkToFit = True ' oCells1.ShrinkToFit = True ' oCells2.ShrinkToFit = True ' oCells3.ShrinkToFit = True ' ' clue number ' dim Cluen as string ' dim lenn as integer ' Cluen = oRangegp.getCellByPosition(4,iPos).getString() ' lenn = len(Cluen) ' ' entry ' dim Entry as string ' dim lene as integer ' Entry = oRangegp.getCellByPosition(5,iPos).getString() ' lene = len(Entry) ' ' fill cells ' oCellg.String = Cluen ' oCellb.String = Cluen + Entry ' oCells1.String = Cluen + Entry ' oCells2.String = Entry ' oCells3.String = Entry ' ' justification ' oCellg.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT ' oCells2.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER ' oCells3.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER ' ' clue number '' if lenn = 0 then ' no clue number ' oCellb.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER ' oCells1.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER ' else ' single or double digit ' oCellb.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT ' oCells1.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT ' ' superscript ' dim oCursg as object ' oCursg = oCellg.getText().createTextCursor() ' oCursg.gotoStart(False) ' oCursg.goRight(lenn, True) ' oCursg.CharEscapementHeight = 50 ' oCursg.CharEscapement = 60 ' ' dim oCursb as object ' oCursb = oCellb.getText().createTextCursor() ' oCursb.gotoStart(False) ' oCursb.goRight(lenn, True) ' oCursb.CharEscapementHeight = 50 ' oCursb.CharEscapement = 60 ' ' dim oCurss1 as object ' oCurss1 = oCells1.getText().createTextCursor() ' oCurss1.gotoStart(False) ' oCurss1.goRight(lenn, True) ' oCurss1.CharEscapementHeight = 50 ' oCurss1.CharEscapement = CInt(oRangegp.getCellByPosition(11,iPos).getString()) ' ' if lene = 1 then ' compress or expand text ' ' kerning ' ' expand ' dim Kernb as integer ' Kernb = CInt(oRangegp.getCellByPosition(10,iPos).getString()) ' if Kernb > 0 then ' oCursb = oCellb.getText().createTextCursor() ' oCursb.gotoStart(False) ' oCursb.goRight(lenn - 1, False) ' oCursb.goRight(1, True) ' oCursb.CharAutoKerning = True ' oCursb.CharKerning = Kernb ' end if ' oCursb.CharAutoKerning = True ' oCursb.CharKerning = bKern ' dim Kerns as integer '' Kerns = CInt(oRangegp.getCellByPosition(9,iPos).getString()) ' if Kerns > 0 then 'expand ' oCurss1 = oCells1.getText().createTextCursor() ' oCurss1.gotoStart(False) ' oCurss1.goRight(lenn - 1, False) ' oCurss1.goRight(1, True) ' oCurss1.CharAutoKerning = True ' oCurss1.CharKerning = Kerns ' else ' condense ' dim Conds as integer ' Conds = CInt(oRangegp.getCellByPosition(8,iPos).getString()) ' if sCond <> 100 then ' oCurss.CharScaleWidth = Conds ' end if ' end if ' end if ' end if ' end if ' iPos = iPos + 1 ' next ' next ' End Sub </script:module>
View Attachment As Raw
Actions:
View
Attachments on
bug 123120
:
148854
| 148855