Code: Alles auswählen
REM ***** BASIC *****
'Copyright (c) 2006 Winfried Rohr, re-Solutions Software Test Engineering
'mailto: ooo@re-solutions.de Untere Zahlbacher Strasse 18, D-55131 Mainz
'This program is free software; you can redistribute it and/or modify it under
'the terms of the GNU General Public License as published by the Free Software
'Foundation; either version 2 of the License, or (at your option) any later
'version.
'This program is distributed in the hope that it will be useful, but WITHOUT
'ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
'FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
'You should have received a copy of the GNU General Public License along with
'this program; if not, write to the Free Software Foundation, Inc., 59 Temple
'Place, Suite 330, Boston, MA 02111-1307 USA
' ========================================================================
' make a copy of actual loaded document
' append a date string to filename
' and store in same location
' notice if already exists
' =====
' Texte fuer Nachrichten
'
' Nachricht1
CONST cDokGefunden = "Dokument ist bereits vorhanden:"
'CONST cDokGefunden = "Document found at location"
CONST cNoNewCopy = "Es wurde keine Kopie erzeugt!"
'CONST cNoNewCopy = "No new copy was made!"
'Nachricht2
CONST cNoLoc = "Dokument noch nicht gespeichert (keine URL gefunden)"
'CONST cNoLoc = "Document was not saved yet (could not find an URL)"
CONST cSaveAndRerun = "Erst sichern, dann Makro eventl. erneut abrufen"
'CONST cSaveAndRerun = "Save first, then run this macro again to make a copy"
'Nachricht3
CONST cRunInBase = "Keine Funktion in OOo BASE"
'CONST cRunInBase = "No function in OOo BASE"
CONST cDontWork = "Makro beendet"
' CONST cDontWork = "Macro finished"
'Nachrichten des ErrHandlers
CONST cErrInLine = "Fehler in Zeile: "
'CONST cErrInLine = "Error in line: "
CONST cErrNo = "Fehler-Nr. "
'CONST cErrNo = "Error-No. "
CONST cErrMod = "Fehler in Makro"
'CONST cErrMod = "Error in macro"
' =====
Sub makeDayCopy()
sMakroName = "makeDayCopy "
sMakroVersion = "2006-05-20"
' try to catch errors and display a message
On Local Error GoTo ErrHandler
' =====
' MAIN
' =====
' get active component
oComp = StarDesktop.CurrentComponent
' macro run from blank Desktop
If oComp.supportsService(_
"com.sun.star.frame.StartModule" ) Then
' exit without action
Exit Sub
End If
' macro run from Basic IDE
If oComp.supportsService(_
"com.sun.star.script.BasicIDE" ) Then
' exit without action
Exit Sub
End If
' macro run from Base main window
'Nachricht3
If oComp.supportsService(_
"com.sun.star.sdb.OfficeDatabaseDocument" ) Then
msgbox cRunInBase & chr(13) &_
cDontWork , 64 , sMakroName & sMakroVersion
Exit Sub
End If
oDok = ThisComponent
'XXX warning
'XXX code will fail on next statement, if no document is loaded
' check if file was stored
If oDok.hasLocation() then
' check if HELP window is in foreground
If Instr( oDok.getLocation() , "vnd.sun.star.help:" ) then
' msgbox "HELP window in foreground"
' exit without action
Exit Sub
End if
' yes, make a copy
' compose additional data to create alternative name for file
' here: datestamp in ISO format used (good for sorting)
sFileURL = oDok.getURL() & "_" & cDateToISO( Now() )
' check if such a file exist
if FileExists( sFileURL ) then
' yes there is one
' issue a message to inform user
msgbox cDokGefunden & chr(13) &_
sFileURL & chr(13) & _
cNoCopyMade ,_
64 ,sMakroName & sMakroVersion
else
' check if we have rights to save there under this name
' how ???
' can save with new name
'## note: no checking on length of filename
'## restricted on some platforms
'## untested _ not sure what will happen
oDok.StoreToURL( sFileURL , Array() )
end if
Else
' no filename by now - cannot do a thing
msgbox cNoLoc & chr(13) &_
cSaveAndRerun , 64 , sMakroName & sMakroVersion
End If
Exit sub
' =====
' =====
ErrHandler:
MsgBox _
cErrInLine & Erl & _
CHR(10) & cErrNo & Err & ": " & Error$ ,, _
cErrMod & sModulName & sModulVersion
End Subich suche verzweifelt
nach einem makro das mir auf knopfdruck aus bestehendem dokument, ein neues mit entsprechendem namen generiert.Das einzige makro welches ich gefunden hab ist das hier oben - leider hängt es das datum hinter die dateiendung an (eben als sicherungskopie).
Schön wäre allerdings stattdessen einfach ein dateiname wie 'aktuellesdatum_uhrzeit.ods' oder noch besser 'rechnungsnummer.ods'
Kann mir jemand das obige evtl. umschreiben oder was ähnliches zeigen - ich selber hab von programmierung leider keine ahnung
besten dank
