AW: [de-users] Calc - heutiges Datum einfügen

Hallo,

der Tipp war 1. Klasse. Musste noch ein paar Änderungen vornehmen und dann hat es geklappt.

Hier noch eine kurze Anleitung:
**********************************************************************************************************************************
Folgendes Problem:
Mit MS Excel kann man das heutige Datum mit "strg+H" statisch einfügen (das heißt, es wird immer 
genau dieses Datum bleiben). 
Dies ist mit LibreOffice nicht so einfach möglich. Bei einigen Benutzern, war diese Funktion aber 
immer sehr wichtig. 

Um Abhilfe zu schaffen, geht man wie folgt vor:

1. In LibreOffice Calc unter Extras -> Makros -> Makros verwalten -> LibreOffice Basic ...
2. Die Dropdown-Auswahl von "Meine Makros" expandieren
3. Die Dropdown-Auswahl von "Standard" expandieren
4. Auf das "Module1" klicken und rechts "Bearbeiten wählen"
5. Im Bearbeitungsfenster sämtlichen Code mit diesem ersetzen:

REM*****BASIC*****
' ! ! !
' anpassen:
' Die zwei folgenden Konstanten bestimmen Datum- und Zeit-Formatcodes 
' Siehe in der F1 Hilfe; sie müssen im Gebietsschema gültig sein.

' adjust:
' following constants define data and time formats to be used;
' for codes to use see in F1 Help. 
' Codes have to be set according to your locale settings

Const  MYDATEFORMAT = "TT.MM.JJJJ"
' Const MYDATEFORMAT = "YYYY-MM-DD"
Const MYTIMEFORMAT = "HH:MM"

' V2
' Format eines Zeitstempels
' Const MYTIMESTAMPFORMAT = "YYYY-MM-DD HH:MM"
Const MYTIMESTAMPFORMAT = "TT.MM.YYYY HH:MM"

' this one is used as separator in
' an ISO-formatted date: 2007-06-24
Const cDateTime_TRENNER = "."


' V2
' neue Schalter für Calc: 
' "Überschreiben- oder Einfügen-" Schalter,
' bei Einfügen: Positionsbestimmung (vor oder hinter vorhandenem Inhalt) 
' bei Einfügen: Trennzeichen (nur beim Einfügen als Text ! )

' new switches to define Calc override / insert behaviour 
' (only with text insertions) 

Const cDateTime_Calc_Add2Text_Switch    = TRUE     
' TRUE: add insert to any existing text or value  
' FALSE: replace text or value (if any)

Const cDateTime_Calc_Add2Text_Position  = "POST"   
' PRE: set insert ahead of an existing text       
' POST: set insert after text 

Const cDateTime_Calc_Add2Text_Separator = ": "     
' definition of part between text and insert 


' used for displaying messages
Const cMODULNAME = "DateTime "
Const cMODULDATUM = "15.08.2007 "
Const cMODULVERSION = "2.0.1 "
' Variablen -------------------------------------------------------------
Private oDesktop
Private oController
Private oDokument
Private oTextCursor
Private oViewCursor

Private oSelection
Private oBereich
Private oZelle
Private oDateTimeField
Private nDateTime_Format_DATE
Private nDateTime_Format_TIME
Private nDateTime_Format_DATETIME
Private oZellEinf as Any
Private oZumEinfuegen
Private nDateTime_SetFormat
Private sDatum

Private sDateTime_setAs   ' val txt
Private sDateTime_setWhat ' DAT TIM
Private sDateTime_DocType ' kind of doc
Private sDateTime_DATE as String 'iso
Private sDateTime_FISO as String ' form. iso
Private sDateTime_DATETIME as String ' iso w/ time
Private sDateTime_TIME as String
Private lDateTime_DATE as Long

Private dblDateTime_TIME as Double

Private oText


CONST cEinzelZelle   = "com.sun.star.sheet.SheetCell"
CONST cVieleBereiche = "com.sun.star.sheet.SheetCellRanges"
CONST cEinzelBereich = "com.sun.star.sheet.SheetCellRange"


' Schalter fuer Cursorposition in Textdokumenten
Private CursorIstHier as Integer
CONST CURPOS_InText = 1
CONST CURPOS_InTabelle = 2
CONST CURPOS_InRahmen = 3
CONST CURPOS_InHeaderFooter = 4

CONST CURPOS_INVALID = 9


' ===========================================================================
'
' M A I N
'
' ===========================================================================

' Eine dieser SUBs aufrufen, einer Symbolschaltfläche oder einer
' Tastenkombination zuordnen. Das Makro erkennt selbst den Dokumententyp.
' (Momentan nur Calc und Writer)
'
' call one of these SUBs, assign to toolbar button or to keyboard combination
' The macro detects document type (calc and writer)
' ===========================================================================

' << Datum als FELD oder WERT
' Sub insert_Date_asField()

Sub Datum_Feld
        sDateTime_setAs   = "val"
        sDateTime_setWhat = "DAT"
        DateTime_Init
        DateTime_action
End Sub


' << Datum als Text
' Sub insert_Date_asText()

Sub Datum_Text
        sDateTime_setAs   = "txt"
        sDateTime_setWhat = "DAT"
        DateTime_Init
        DateTime_action
End Sub



' << Zeit als FELD oder WERT
' Sub insert_Time_asField()

Sub Zeit_Feld
        sDateTime_setAs   = "val"
        sDateTime_setWhat = "TIM"
        DateTime_Init
        DateTime_action
End Sub

' << Zeit als Text
' Sub insert_Time_asText()

Sub Zeit_Text
        sDateTime_setAs   = "txt"
        sDateTime_setWhat = "TIM"
        DateTime_Init
        DateTime_action
End Sub


'
' << Zeitstempel als Text

Sub Zeitstempel_Feld
        sDateTime_setAs   = "val"
        sDateTime_setWhat = "T_S"
        DateTime_Init
        DateTime_action
End Sub

' << Zeitstempel als Text

Sub Zeitstempel_Text
        sDateTime_setAs   = "txt"
        sDateTime_setWhat = "T_S"
        DateTime_Init
        DateTime_action
End Sub


' ===========================================================================
' Allgemeiner Codeteil
'
' ===========================================================================

' Aktuelles Dokument
'
Sub DateTime_Init
oDesktop = _
 createUnoService( "com.sun.star.frame.Desktop" )
oController = _
 oDesktop.getCurrentFrame().getController()
oDokument = _
 oController.Model
If NOT DateTime_isDocTypeOK( oDokument ) then
        ' Dokumententyp nicht unterstützt
        Msgbox _
        "Dokumententyp wird nicht unterstützt" _
        ,64, _
        cMODULNAME & "V " & cMODULVERSION

'       print "Dokument not supported"
        STOP
End If

' diese Zeit nehmen/speichern
DateTime_secureNow

If sDateTime_setAs = "val" Then
 ' Aufbereiten der gewünschten Formatierung
 DateTime_setNumFormat
End If

End Sub




' Bestimmen des Dokumententyps
' aktuell: Writer, Calc, HTML
Function DateTime_isDocTypeOK( oDok ) as Boolean
DateTime_isDocTypeOK = FALSE

If oDok.supportsService(_
 "com.sun.star.text.TextDocument" ) Then
 sDateTime_DocType = "WRITER"
 DateTime_isDocTypeOK = TRUE
 Exit Function
ElseIf oDok.supportsService(_
 "com.sun.star.text.WebDocument" ) THEN
 sDateTime_DocType = "WRITERWEB"
 DateTime_isDocTypeOK = TRUE
 Exit Function
ElseIf oDok.supportsService(_
 "com.sun.star.sheet.SpreadsheetDocument" ) Then
 sDateTime_DocType = "CALC"
 DateTime_isDocTypeOK = TRUE
 Exit Function
Else
 sDateTime_DocType = "-n/a-"
 DateTime_isDocTypeOK = FALSE
End If

End Function

' ===========================================================================
' Codeteil fuer Datum
'
'
' ===========================================================================
Sub DateTime_secureNow
' lokales speichern der Systemzeit
' nummerische Werte
lDateTime_DATE = DateValue( NOW ) '
dblDateTime_TIME = CDbl( NOW )
' Zeichenfolgen
' Das Rueckgabeformat der Funktion "Date" ist von dem Gebietsschema
' abhaengig, deshalb gewuenschtes Format durch Textmanipulation
' zusammensetzen
' msgbox Date zeigt: 21.11.2005
 ' Right(Date,4) & "-" & Mid(Date,4,2) & "-" & left(Date,2)
 ' soll: JJJJ-MM-TT 2005-11-21
sDateTime_DATE = CDateToISO( Now )
' now: jjjjmmtt 20051121'
' use this variable if needed
'

' compose a ISO formatted date
sDateTime_FISO = _
 Left( sDateTime_DATE, 4 ) & _
 cDateTime_TRENNER & _
 Mid( sDateTime_DATE, 5 , 2 ) & _
 cDateTime_TRENNER & _
 Right( sDateTime_DATE, 2 )
 ' durch Apostroph erzwungenes Textformatnumber
 ' forced text format


' die Funktion TIME gibt 12:34:56
' im Format hh:mm:ss zurück
' Textteil ausschneiden
sDateTime_TIME = _
 Mid( TIME, 1, 5 )

' Zeitstempel zusammen setzen
sDateTime_DATETIME = _
 sDateTime_FISO & _
 " " & _
 sDateTime_TIME


End Sub

Sub DateTime_setNumFormat
' Abfragen ob gewuenschtes Format schon definiert
' hier: benutzerdefiniertes Datumsformat
' query if user-defined date format already in locale settings
Dim aLocale As New com.sun.star.lang.Locale

oFormats = _
 oDokument.NumberFormats

nDateTime_Format_DATE = _
 oFormats.queryKey( MYDATEFORMAT, aLocale, True )
' Schluesselwert nicht gefunden: hinzufuegen Format
' format not found - key not returned: add format
If nDateTime_Format_DATE < 0 Then
 nDateTime_Format_DATE  = _
 oFormats.addNew( MYDATEFORMAT, aLocale )
End If

nDateTime_Format_TIME = _
 oFormats.queryKey( MYTIMEFORMAT, aLocale, True )

' Schluesselwert nicht gefunden: hinzufuegen Format
' format not found - key not returned: add format
If nDateTime_Format_TIME < 0 Then
 nDateTime_Format_TIME = _
 oFormats.addNew( MYTIMEFORMAT, aLocale )
End If




nDateTime_Format_DATETIME = _
 oFormats.queryKey( MYTIMESTAMPFORMAT, aLocale, True )

' Schluesselwert nicht gefunden: hinzufuegen Format
' format not found - key not returned: add format
If nDateTime_Format_DATETIME < 0 Then
 nDateTime_Format_DATETIME = _
 oFormats.addNew( MYTIMESTAMPFORMAT, aLocale )
End If


End Sub








' Hauptroutine zur Arbeitssteuerung
'
Sub DateTime_action()

' on what document do we work
Select Case sDateTime_DocType

 Case "CALC" ' Calc Dokument
        ' die Auswahl (Zelle/n, Bilder, andere Objekte)
        oSelection = oController.getSelection()

        If IsNull( oSelection ) Then
         Exit Sub
        End If

        ' Fehlerbehandlung: keine Zelle(n)
        ' error handling: no cell(s) selected
        If Not oSelection.supportsService(_
         "com.sun.star.table.CellProperties" ) Then
         exit sub
        End If


        Select Case sDateTime_setWhat & sDateTime_setAs
         Case = "DATval"
                oZellEinf = lDateTime_DATE
                nDateTime_SetFormat = nDateTime_Format_DATE
         Case = "DATtxt"
                oZellEinf = sDateTime_FISO
         Case = "TIMval"
                oZellEinf = dblDateTime_TIME
                nDateTime_SetFormat = nDateTime_Format_TIME
         Case = "TIMtxt"
                oZellEinf = sDateTime_TIME
         Case = "T_Sval"
                oZellEinf = dblDateTime_TIME
                nDateTime_SetFormat = nDateTime_Format_DATETIME
         Case = "T_Stxt"
                oZellEinf = sDateTime_DATETIME
         Case Else
                 Exit Sub
        End Select

        DateTime_setCalc( oSelection , oEinf )


 Case "WRITER" , "WRITERWEB" ' Writer Dokument
        ' als Wert
        if sDateTime_setAs= "val" then

                ' Textfeld erzeugen
                oDateTimeField = oDokument.createInstance( _
                        "com.sun.star.text.TextField.DateTime" )
                ' einstellen:
                        ' Schalter "fest" = wird zur Ausfuehrung gesetzt und nicht geaendert
                        ' Schalter "ist ein Datum" einstellen
                        ' ermitteltes Datumsformat (ist Nummernformat) anwenden
                        ' apply date (number) format
                Select Case sDateTime_setWhat
                        Case = "DAT"
                                nDateTime_SetFormat = nDateTime_Format_DATE
                        Case = "TIM"
                                nDateTime_SetFormat = nDateTime_Format_TIME
                        Case = "T_S"
                                nDateTime_SetFormat = nDateTime_Format_DATETIME
                        Case Else
                            Exit Sub
                End Select

                With oDateTimeField
                        .IsFixed = True
                        .IsDate = True
                        .NumberFormat = nDateTime_SetFormat
                End With
                ' in das Dokument eintragen
                oZumEinfuegen = oDateTimeField
                DateTime_setWriter( oZumEinfuegen )


        ' als Text
        Else
                ' in das Dokument eintragen
                Select Case sDateTime_setWhat
                        Case = "DAT"
                                oZumEinfuegen = sDateTime_FISO
                        Case = "TIM"
                                oZumEinfuegen = sDateTime_TIME
                        Case = "T_S"
                                oZumEinfuegen = sDateTime_DATETIME
                        Case Else
                                Exit Sub
                End Select


                DateTime_setWriter( oZumEinfuegen )

        End If

 Case Else
         print "forgotten doc type"

End Select

End Sub
' ===========================================================================





' ===========================================================================



' ===========================================================================
' Routine zum Eintragen Writer
Sub DateTime_setWriter( sFeldZumEinfuegen )

' Objekt des sichtbaren Cursors
oViewCursor = oController.ViewCursor

' Routine aufrufen
' Cursorstandort bestimmen
' determine where the cursor is
DateTime_suchTxtCursor( oViewCursor )


' je nach Position des Cursors unterschiedlicher Zugriff
' different access depending on cursor position
Select Case CursorIstHier

        '----------------------------------------------------------------------------
        ' cursor in text
        Case CURPOS_InText
                if sDateTime_setAs= "val" then
                        oDokument.getText().insertTextContent( _
                        oViewCursor, oZumEinfuegen , False )
                else
                        oTextCursor = _
                        oDokument.getText().createTextCursorByRange( oViewCursor )
                        oTextCursor.String = oZumEinfuegen
                end if
        '---------------------------------------------------------------------------- 
        'cursor in texttable
        Case CURPOS_InTabelle
                oZelle = oViewCursor.Cell
                if sDateTime_setAs= "val" then
                        oZelle.getText().insertTextContent( _
                        oViewCursor, oZumEinfuegen, False )
                else
                        oTextCursor = oZelle.getText().createTextCursorByRange( oViewCursor )
                        oZelle.insertString( oTextCursor, oZumEinfuegen, FALSE )
                end if
        '---------------------------------------------------------------------------
        ' cursor in frame
        Case CURPOS_InRahmen
                if sDateTime_setAs= "val" then
                        oRahmen = oViewCursor.TextFrame()
                        oRahmen.getText().insertTextContent( _
                        oViewCursor, oZumEinfuegen, False )
                else
                        oRahmen = oViewCursor.TextFrame()
                        oRahmen.getText().insertText( _
                        oViewCursor, oZumEinfuegen, False )
                end if
        '---------------------------------------------------------------------------
        ' in Kopf- oder Fusszeile
        ' cursor in header or footer
        Case CURPOS_InHeaderFooter
                if sDateTime_setAs= "val" then

                        ' Feld einfügen
                        ' insert field
                        oText.insertTextContent( _
                        oViewCursor, oZumEinfuegen, False )
                else
                        oTextCursor = oText.createTextCursorByRange( oViewCursor )
                        oText.insertString( oTextCursor, oZumEinfuegen, FALSE )
                end if
        '---------------------------------------------------------------------------
        Case Else
                ' not yet programmed
End Select

End Sub


' ===========================================================================
' Diese Routine bestimmt die Position des sichtbaren Cursors im Text eines
' Writer Dokuments
' momentan wird die Position erkannt in: 
' Tabellen, Textrahmen, Kopf- und Fusszeilen

' This routine determines position of viewable cursor within a writer doc
' detects: cursor in texttable, textframe, header and footer
Sub     DateTime_suchTxtCursor( oViewCursor )

' init Zeiger fuer Position
CursorIstHier = 0


' Sonderfall: Cursor im Bereich Kopf-/Fusszeile
if oViewCursor.getText().ImplementationName = "SwXHeadFootText" then
        oText = oViewCursor.getText()
        CursorIstHier = CURPOS_InHeaderFooter
        exit sub
end if

if Not IsEmpty( oViewCursor.TextTable ) then
        CursorIstHier = CURPOS_InTabelle
        exit sub
end if

if Not IsEmpty( oViewCursor.TextFrame ) then
        CursorIstHier = CURPOS_InRahmen
        exit sub
end if


' Cursor ist immer "im Text", deshalb diesen Schalter zuletzt setzen
' cursor always "in" text, so set this trigger last
if Not IsEmpty( oViewCursor.Text ) then
        CursorIstHier = CURPOS_InText
end if

End Sub





' ===========================================================================
' Calc Dokumente

Sub DateTime_setCalc( oSelection , oEinf )
Dim oEinBereich

' Zelle / Bereich / mehrere Bereiche ?

If      oSelection.supportsService( cEinzelZelle ) Then
' single cell
    DateTime_setZelle( oSelection )
ElseIf _
        oSelection.supportsService( cVieleBereiche ) Then
        ' mehrere Bereiche
    For i = 0 To oSelection.getCount() - 1
      oEinBereich = oSelection.getByIndex(i)
      DateTime_setCalc( oEinBereich )
    Next
ElseIf _
        oSelection.supportsService( cEinzelBereich ) Then
'       ein Bereich von Zellen
    DateTime_set1Bereich( oSelection )
End If

End Sub


' Calc
' einzelne Zelle
Sub DateTime_setZelle( oSel )

If sDateTime_setAs= "val" Then
 ' Wert geht über Formatierung
 With oSel
  .FormulaLocal = oZellEinf
  .NumberFormat = nDateTime_SetFormat
 End With
Else
' sDateTime_setAs= "txt"
  ' V2
  If cDateTime_Calc_Add2Text_Switch = TRUE Then
    Dim sTempText
    sTempText = oSel.getString()
    If ( Len( sTempText ) > 0 ) Then
       Select Case cDateTime_Calc_Add2Text_Position
         Case = "PRE"
             sTempText = _
               oZellEinf & _
               cDateTime_Calc_Add2Text_Separator & _
               oSel.getString()
               oSel.setString( sTempText )

         Case = "POST"
             sTempText = _
               oSel.getString() & _
               cDateTime_Calc_Add2Text_Separator & _
               oZellEinf
               oSel.setString( sTempText )
         Case Else
           Exit Sub
         End Select
    Else
          oSel.setString( oZellEinf )
        End IF
        
  Else
    oSel.setString( oZellEinf )
  End IF
End If
End Sub


' Calc
' einen Bereich von Zellen setzen
Sub DateTime_set1Bereich( oSelection )

' Daten des Bereichs
oDaten() = oSelection.getDataArray()
' die Zeilen des Bereichs
' zz: ZählerZeilen
for zz = _
        LBound( oDaten() ) to _
        UBound( oDaten() )

        oDatenZeile() = oDaten( zz )
        ' zz: ZählerZeilen

        ' pro Zeile die cells/Zellen
        ' zc: ZählerCells
        for zc = _
                LBound( oDatenZeile() ) to _
                UBound( oDatenZeile() )

                oDatenZeile( zc ) = oZellEinf
        next ' Zellen
next ' nächste Datenzeile


' Daten auf diesen Bereich
oSelection.setDataArray( oDaten() )
If sDateTime_setAs= "val" Then
 ' Datumformat (ist ein Nummernformat) anwenden
 ' apply date (number) format
 oSelection.NumberFormat = nDateTime_SetFormat
End If

End Sub

' -------------------------------------------------------

5a. Bearbeitungsmodus schließen
6. Einen Rechtsklick auf eine Symbolleiste machen und "Symbolleiste anpassen" wählen
7. Den Reiter "Tastatur" wählen und den Eintrag strg+H suchen und markieren
8. Im unteren Bereich im linken Fensterchen LibreOffice Makros wählen und dort folgenden Pfad 
expandieren "user-> Standard-> Module1"
9. Im nächsten Fenster nach rechts den Eintrag "Datum_Feld" wählen
10. Oben auf "Ändern" klicken. Dem Makro wird die Tastenkombination strg+H hinzugefügt

Fertig
***************************************************************************************************************************************

Hoffe das es noch einige andere gebrauchen können.

Viele Grüße
Kai Klostermann

-----Ursprüngliche Nachricht-----
Von: Rainer Bielefeld [mailto:LibreOffice@bielefeldundbuss.de] 
Gesendet: Friday, September 30, 2011 9:10 AM
An: users@de.libreoffice.org
Betreff: Re: [de-users] Calc - heutiges Datum einfügen

Oder
<http://extensions.services.openoffice.org/project/DateTime2>

Rainer

-- 
Informationen zum Abmelden: E-Mail an users+help@de.libreoffice.org
Tips zu Listenmails: http://wiki.documentfoundation.org/Netiquette/de
Listenarchiv: http://listarchives.libreoffice.org/de/users/
Alle E-Mails an diese Liste werden unlöschbar öffentlich archiviert


-- 
Informationen zum Abmelden: E-Mail an users+help@de.libreoffice.org
Tips zu Listenmails: http://wiki.documentfoundation.org/Netiquette/de
Listenarchiv: http://listarchives.libreoffice.org/de/users/
Alle E-Mails an diese Liste werden unlöschbar öffentlich archiviert