[RESUELTO] Macro en Calc

[Juan José]

Buenas noches Amigos

Por este medio quisiera solicitar su ayuda para que por favor puedan apoyarme con el desarrollo de una macro en Calc. Realmente soy completamente nuevo con esto de las macros y por tal motivo, solicito su amable ayuda con el desarrollo de lo siguiente:

Cuando ingrese en una celda un código cualquiera, por ejemplo R0, que instantaneamente pueda aparecer en la columna de al lado, la fecha y hora del sistema, pero que permanezca fija.

Agradeceré muchísimo toda su ayuda y colaboración.

Saludos.

[FJCC-ES]

El código aquí inserta la fecha y hora automáticamente.

[Juan José]

Muchas gracias por tu ayuda. Tengo una consulta, la macro funciona aunque la versión del OpenOffice sea la 3.0?

Nuevamente gracias por tu apoyo!

[FJCC-ES]

Sí, la macro en OOo Basic que publiqué en este foro funciona en 3.0.

[Juan José]

Buena noche Amigo

Mil disculpas por volver a molestarte. Fíjate que cuando sigo las instrucciones indicadas me da el siguiente error:

"Error de ejecución de BASIC. Subprocedimiento o procedimiento de función no definidos"

Y la línea que señala es la de la instrucción:

splitStringAddress(sAddr,s,r)

Tal vez sea un error tonto, pero como te comentaba antes, soy completamente nuevo en esto de las macros y hay algunas cosas que desconozco.

Mil gracias por tu ayuda.

[FJCC-ES]

Creo que no copió una parte del código. Aquí esta el código entero

Código: Seleccionar todo

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 

[Juan José]

Amigo, eres fenomenal!!!!

Muchísimas Gracias por toda tu ayuda!!!! El código funciona a la perfección.

Atentamente,

Juan José