LibreOffice-Forum

Code: Alles auswählen

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

option explicit

'   library:    Beispiel    module:    Graph    by:    nitja    last update:    24·04·06    status:    very start of design
'   called by:    so far(?) only onActivate is "called" (triggered by manual activation) from "outside"
'   calls (outside of this module):    nothing

const sMonthTmplt="99·99"
dim isInitd as boolean,oDoc as object,oNmdRngs as object,oCharts as object,oCtrlr as object,oGkSht as object
dim sMonth(1) as string,sGfkPg(1) as string,oGfkPg(1) as object,oGPgRa(1) as object
dim oChart(1) as object,sChart(1) as string
dim vTest '                                                                                                     ⚒🌩💢⚠❓🤔🪳

sub test
'   dim <local variables>
'   processing:
    vTest="dummy"
    print vTest
    stop
end sub 'test

sub onActivate
    if not isInitd then doInit
end sub 'onActivate

sub doInit
    if isInitd then exit sub
    oDoc=thisComponent
    oNmdRngs=oDoc.NamedRanges
    oGkSht=oDoc.Sheets.getByIndex(0)
    oCharts=oGkSht.getCharts
    sMonth=Array(Format(DateAdd("m",-1,Date),"yy·mm"),Format(Date,"yy·mm"))
    sGfkPg=Array("Grafikseite" & Replace(sMonth(0),"·","_"),"Grafikseite" & Replace(sMonth(1),"·","_"))
    sChart=Array("Diagramm" & sMonth(0),"Diagramm" & sMonth(1))
    if not oNmdRngs.hasByName(sGfkPg(1)) then NewPage
    if not oCharts.hasByName(sChart(1)) then NewChart
    isInitd=true
end sub 'doInit

sub NewPage
    dim oRng as object, oRfCellAddr as object
'   check presence of previous month's region/page to be used as a template
    if not oNmdRngs.hasByName(sGfkPg(0)) then
'       MsgBox("You'll have to define it manually!" & chr(10) & _
'       "('" & oGkSht.Name & "'is in the leftmost sheet-tab of Calc's main window )", _
'       MB_ICONSTOP,"named range '" & sGfkPg(0) & "'is missing")
        MsgBox("Der muss manuell markiert & festgelegt werden!" & chr(10) & _
        "('" & oGkSht.Name & "'ist im 1. Register links unter den Tabellen in Calcs Hauptfenster)", _
        MB_ICONSTOP,"Benannter Bereich '" & sGfkPg(0) & "'fehlt")
        stop
    end if 'graphic page for previous month missing
    oRfCellAddr=oGkSht.getCellByPosition(0,0).getCellAddress()
    oGfkPg(0)=oNmdRngs.getByName(sGfkPg(0)).getReferredCells
    oGPgRa(0)=oGfkPg(0).RangeAddress
    with oGPgRa(0)                                                                                             'create new region/page for the new month
        oRng=oGkSht.getCellRangeByPosition(.StartColumn,.StartRow+33,.EndColumn,.EndRow+33)
        oNmdRngs.addNewByName(sGfkPg(1),oRng.AbsoluteName,oRfCellAddr,0)                                       'cf. Pitonyak et al. 16.6.1 pgs.531-534
        oGfkPg(1)=oNmdRngs.getByName(sGfkPg(1)).getReferredCells
'       copy & paste will have to be specified here
'       formulae will already be adjusted for the third and later months, when copying them from the previous month in the sheet (done manually for the second one)
'       data will have to be reviewed and automatic adjustment will have to be specified here
    end with
end sub 'NewPage

sub NewChart
'   check presence of previous month's chart to be used as a template
    if not oCharts.hasByName(sChart(0)) then
'       MsgBox("You'll have to create it manually!", _
'       MB_ICONSTOP,"chart '" & sChart(0) & "'is missing")
        MsgBox("Das muss manuell erstellt werden!", _
        MB_ICONSTOP,"'" & sChart(0) & "'fehlt")
        stop
    end if 'chart for previous month missing
    oChart(0)=oCharts.getByName(sChart(0))
    with oChart(0)
        print "check " & sChart(0)
    end with    
end sub 'NewChart

Code: Alles auswählen

vTest=oCharts.getByName("Object 1")

Code: Alles auswählen

vTest.setName(sChart(0))

Code: Alles auswählen

oDrawpage=ThisComponent.Sheets(0).DrawPage
oShape=oDrawpage.getByIndex(oDrawpage.Count-1)

Code: Alles auswählen

oShape.EmbeddedObject.EntryName

Code: Alles auswählen

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

option explicit

'	by:		nitja		last update:	24·04·08		status:		in progress, 1 ⚒complement⚒, 1 ⚠oddness⚠ resolved? ¹
'	called by:							s̶y̶s̶t̶e̶m sheet events, living only @ sheets, for which they've explicitly been set
'	calls (outside of this module):		nothing, s̶o̶ ̶f̶a̶r (adjust graph for new month lives in 'Graph' module)
'	¹) sort of loose ends… 

const sMonthTmplt="99·99"
dim isInitd as boolean,oDoc as object,oCtrlr as object,oDtSht as object,oCrsr as object
dim lRow as integer,nRecs as integer,hasNewRec as boolean,hasGaps as boolean
dim aSel,iSht as integer,iCol as integer,iRow as integer
dim vTest '																										⚒🌩💢⚠❓🤔🪳

sub test
'	dim <local variables>
'	processing:
	if not isInitd then doInit
	vTest=oDoc.getEvents
	vTest=oDtSht.getEvents
	stop
end sub 'test

sub onActivate
'	called by:	s̶y̶s̶t̶e̶m sheet event, living only @ sheets, for which it's been explicitly set	triggered:	manually or by doInit»NewMonth
	if not isInitd then doInit
	with oDoc.CurrentSelection.RangeAddress : aSel=Array(.Sheet,.EndColumn,.EndRow) : end with
	if 1=aSel(0) then
		oDtSht.getCellByPosition(1,lRow).setValue(day(now)+timevalue(now))
		aSel=Array(1,2,lRow)
	else aSel=Array(aSel(0),0,0)
	end if
	doSlct(aSel) : stop '																						stop for manual input
end sub 'onActivate

sub doInit
	if isInitd then exit sub
	oDoc=thisComponent
	oCtrlr=oDoc.getCurrentController
	oDtSht=oDoc.Sheets.getByIndex(1)
	with oDoc.CurrentSelection.RangeAddress : aSel=Array(.Sheet,.EndColumn,.EndRow) : end with
	if 1=aSel(0) then
		oCrsr=oDtSht.createCursorByRange(oDtSht.getCellRangeByPosition(0,0,0,0))
		oCrsr.collapseToCurrentRegion
		lRow=oCrsr.RangeAddress.EndRow
		hasNewRec=(oDtSht.getCellByPosition(0,lRow).string=" 🖎") '												hasNewRec: .string=" 🖎""  - otherwise "✔""
		nRecs=oDtSht.getCellByPosition(0,1).value '																# of complete records (data rows)
		hasGaps=lRow-nRecs-1+hasNewRec
		isInitd=True
		if hasGaps then doFillGaps '																			incl. stop for manual input
		if Format(Date,"yy·mm")<>oDtSht.Name then NewMonth
		if not(hasNewRec) then doMakeNewRec
	end if
	isInitd=true
end sub 'doInit '																								⚠sort of a loose end?⚠ resolved?

sub doSlct(aRng,optional vActiv)
'	called by:	onActivate, doFillGaps, doMakeNewRec, onDblClk
	dim oRng as object
	if not isInitd then doInit
	if ubound(aRng)=2 then oCtrlr.select(oDoc.Sheets(aRng(0)).getCellByPosition(aRng(1),aRng(2)))
	oRng=oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
	if isMissing(vActiv) then oCtrlr.Select(oRng)
	stop
end sub 'doSlct

sub doFillGaps
	with oDtSht
		for iRow=2 to lRow
			if .getCellByPosition(0,iRow).string=" 🖎" then exit for
		next 'iRow
		for iCol=2 to 5
			if 0=.getCellByPosition(iCol,iRow).type then exit for
		next 'iCol
		doSlct(array(iCol,iRow)) : stop '																		stop for manual input
	end with 'oDtSht
end sub 'doFillGaps

sub doMakeNewRec
	lRow=lRow+1 : iRow=lRow
	with oDtSht
		.getCellByPosition(0,iRow).setFormula("=COUNTBLANK(C" & iRow+1 & ":F" & iRow+1 & ")=0") '				=COUNTBLANK(C25:F25)=0
		 with .getCellByPosition(5,iRow)
			.setFormula("=IF(ISBLANK(E" & iRow+1 & ");CHAR(24);" & 1-.value & ")") ' 							=IF(ISBLANK(E3);CHAR(24);…1⇌0…) 
		 end with '.getCellByPosition(5,iRow)
		.getCellByPosition(7,iRow).setFormula("=IF(E"& iRow+1 &";IF(F"& iRow+1 &";-99;E"& iRow+1 &");-99)") '	=IF(E25;IF(F25;-99;E25);-99)
		.getCellByPosition(8,iRow).setFormula("=IF(E"& iRow+1 &";IF(F"& iRow+1 &";E"& iRow+1 &";-99);-99)") '	=IF(E25;IF(F25;E25;-99);-99)
	end with
	hasNewRec=true : doSlct(array(2,lRow))
end sub 'doMakeNewRec '																							⚠sort of a loose end?⚠ resolved?

function onDblClk(oCell as object) as boolean
'	called by:	s̶y̶s̶t̶e̶m sheet event, living only @ sheets, for which it's been explicitly set
	dim oRng as object
	if not isInitd then doInit 
	onDblClk=true'																								intercept s̶y̶s̶t̶e̶m sheet event (Pitonyak 11.10, last ⁋)
	oRng=oCell.RangeAddress
	iCol=oRng.EndColumn : iRow=oRng.EndRow
	select case iCol
	case 0
		oDtSht.getCellByPosition(1,iRow).setValue(day(now)+timevalue(now)) : iCol=2
	case 5
		with oDoc.Sheets.getByIndex(aSel(0)).getCellByPosition(5,iRow)
			.setFormula("=IF(ISBLANK(E" & iRow+1 & ");CHAR(24);" & 1-.value & ")") ' 							=IF(ISBLANK(E3);CHAR(24);…1⇌0…) 
		end with 'oDoc.Sheets.getByIndex(aSel(0)).getCellByPosition(5,iRow)
	end select 'case iCol
	doSlct(array(aSel(0),iCol,iRow)) : stop '																	stop for manual input
end function 'onDblClk

sub NewMonth
	dim args(1) As New com.sun.star.beans.PropertyValue
	args(0).Name = "EventType" : args(0).Value = "Script" : args(1).Name = "Script"
	if not isInitd then doInit
	oDtSht=oDoc.Sheets.getByIndex(1)
	with oDtSht
		 args(1).Value = "vnd.sun.star.script:Beispiel.Data.onActivate?language=Basic&location=document"
		.Events.replaceByName("OnFocus",args())
		 args(1).Value = "vnd.sun.star.script:Beispiel.Data.onDblClk?language=Basic&location=document"
		.Events.replaceByName("OnDoubleClick",args())
		.getCellByPosition(0,0).setString(Format(Date,"yyyy"))
		.getCellByPosition(1,0).setString(Format(Date,"mmm"))
	end with 'oDtSht
	lRow=2
	oCtrlr.setActiveSheet(oDtSht)
end sub 'NewMonth