REM ***** BASIC *****
Sub test_splitStringAddress()
Dim s$,sSh$,sRg$
a=Array("'my sheet'.A1", _
"$'my sheet'.A", _
"'file:///doc.ods'#'my sheet'.A1", _
"$'file:///doc.ods'#$'my sheet'.A")
for i= 0 to uBound(a())
s = a(i)
splitStringAddress(s,sSh,sRg)
print sSh,sRg
next
End Sub
sub splitStringAddress(s$, sSheet$, sRange$)
dim sURL$, linkPos%, sheetPos%
' remove leading $ in any case:
if left(s, 1) = "$" then s = mid(s, 2)
linkPos = instr(s, "'#")
if linkPos > 0 then
sheetPos = instr(linkPos, s, ".")
sURL = left(s, linkPos +1)
sSheet = mid(s, linkPos +2, sheetPos -linkPos -2)
sRange = mid (s, sheetPos +1)
else
sheetPos = instr(s, ".")
if sheetPos > 0 then
sSheet = left(s, sheetPos -1)
sRange = mid (s, sheetPos +1)
else
sRange = s
endif
endif
if left(sSheet, 1) = "$" then sSheet = mid(sSheet, 2)
if (left(sSheet, 1) = "'") and (right(sSheet, 1) = "'") then
sSheet = mid(sSheet, 2, len(sSheet) -2)
endif
sSheet = sURL & sSheet
end sub
'-------usefull helper-function, returning focussed cell
'by UROS > http://www.oooforum.org/forum/viewtopic.phtml?t=19348
REM 2006-08-09: fixed error when row > 8191
' ;sh; ;lSheet +3
'100/60/0;1;tw:309;2/2/0/0/0/0/2/0/0/0/0;253/8191/0/0/0/0/2/246/0/0/8158;0/0/0/0/0/0/2/0/0/0/0
'100/60/0;1;tw:309;2/2/0/0/0/0/2/0/0/0/0;253+8192+0+0+0+0+2+246+0+0+8158;0/0/0/0/0/0/2/0/0/0/0
Function getActiveCell(oView)
Dim as1(), lSheet&,lCol&,lRow$, sDum as String,bErr as Boolean
as1() = Split(oView.ViewData, ";")
lSheet = CLng(as1(1))
sDum = as1(lSheet +3)
as1() = Split(sDum, "/")
on error goto errSlash
lCol = CLng(as1(0))
lRow = CLng(as1(1))
on error goto 0
getActiveCell = oView.Model.getSheets.getByIndex(lSheet).getcellByPosition(lCol,lRow)
exit Function
errSlash:
if NOT(bErr) then
bErr = True
as1() = Split(sDum, "+")
resume
endif
End Function
Sub printStamp(oCell)
'''Put the current time into the active cell.
'No formatting intended. Apply any date/time formatting you like.'''
oCell.setFormula("=NOW()")
oCell.setValue(oCell.getValue())
End Sub
Sub _NowToColumnAByValidation(sAddr, bOverwrite)
Dim s$,r$
iCol = 0
doc = thisComponent
splitStringAddress(sAddr,s,r)
sh = doc.Sheets.getByName(s)
rg = sh.getCellRangeByName(r)
iRow = rg.RangeAddress.StartRow
c = sh.getCellByPosition(iCol, iRow)
if bOverwrite or (len(c.getFormula())=0)then printStamp(c)
End Sub
Sub _NowToTimeStampCell(bOverwrite)
oNames = thisComponent.NamedRanges
oName = oNames.getByName("TimeStamp")
oRg = oName.getReferredCells()
c = oRg.getCellByPosition(0,0)
if bOverwrite or (len(c.getFormula())=0)then printStamp(c)
End Sub
Sub NowToEmptyColumnAByValidation(sFormula, sAddr):
'''Current time to empty column A, triggered by failing validation'''
_NowToColumnAByValidation(sAddr, False)
End Sub
Sub NowToColumnAByValidation(sFormula, sAddr):
'''Current time to column A, triggered by failing validation'''
_NowToColumnAByValidation(sAddr, True)
End Sub
Sub NowToTimeStampCell():
'''Put current time into a cell named "TimeStamp"'''
_NowToTimeStampCell(True)
End Sub
Sub NowToEmptyTimeStampCell():
'''Put current time into an empty cell named "TimeStamp"'''
_NowToTimeStampCell(False)
End Sub
Sub NowToActiveCell():
'''Put current time into the currently active input cell'''
oDoc = thisComponent
oView = oDoc.getCurrentController()
oCell = getActiveCell(oView)
printStamp(oCell)
End Sub
Sub _NowToColumnAByValidation(sAddr, bOverwrite)
Dim s$,r$
iCol = 0 'Cambie la columna aqui. Columna A=0, B=1, C=2, etc.
doc = thisComponent
splitStringAddress(sAddr,s,r)
sh = doc.Sheets.getByName(s)
rg = sh.getCellRangeByName(r)
iRow = rg.RangeAddress.StartRow
c = sh.getCellByPosition(iCol, iRow)
if bOverwrite or (len(c.getFormula())=0)then printStamp(c)
End Sub
xiseme escribió:Ahora bien, ¿como ha hecho Mauricio para que la macro sólo se ejecute al modificar las celdas A2-A20 y C2-C20 y sólo con esas?
Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 4 invitados