OpenOffice.info

von **cruzylin** » Mi, 23.02.2011 21:32

@ Komma4

Vielen Dank für dein Makro, ich habe es als Grundlage an meine Bedürfnisse angepasst.

von **dcssd** » Mo, 26.07.2010 10:40

Guten Morgen, bzw Mahlzeit

//Hatte bisher noch nicht deinen Wohnort gesehen, war erst etwas überrascht warum du Mittags, zum Abendessen gehst, aber hatte es mir mit einer langen Anfahrt erkärt. Aber Ok, nun schaut das anders aus.

Es funktioniert alles sehr gut. Genauso hab ich mir das Vorgestellt, Vielen Vielen Dank!!!

Ich hab noch 2 Änderungen rein gemacht, die will ich natürlich noch schnell mit her schreiben

Code: Alles auswählen

  Sub Fixieren_und_Speichern
    ' Sub de39625
    ' 2010-07-23
    ' Kopieren eines definierten Bereich aus dem aktuellen Tabellenblatt
    ' in eine neue Datei einfügen (Werte, nicht Formeln)
    ' speichern unter einem Dateinamen, der aus Zelle N4 kommt
    '
    ' 2010-07-25
    ' NEUER ABLAUF:
    ' Speichern unter neuem Dateinamen (aus N4)
    ' Abfrage beim Überschreiben
    ' Einfügen der Werte
    ' Löschen der nicht benötigten Tabellenblätter
    '


    ' Linux: vom root-Verzeichnis aus (ohne root-slash!), bspw. zentrale/daten
    ' Windows: bspw. d:/daten/2010/
    CONST cVerzeichnis = "C:/asdf/"


    ' Name des Blattes, das ERHALTEN bleiben soll
    CONST sBlattBehalten = "Prod"


    CONST sMakroName = "Fixieren und Speichern"
    CONST sMakroVersion = " v1.0.0"


    rem ----------------------------------------------------------------------
    rem define variables
    dim document   as object
    dim dispatcher as object




    rem ----------------------------------------------------------------------
    rem get access to the document
    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

    rem ----------------------------------------------------------------------

    ' Zusammensetzen des Dateinamens


    sBlattName = document.Controller.ActiveSheet.Name
    sZellwertN4 = _
    ThisComponent.Sheets().getByName( sBlattName ).getCellRangeByName( "N4" ).String


    rem ----------------------------------------------------------------------

    ' SpeichernAls:

    sNeuDatei = "file:///" & cVerzeichnis & sZellwertN4 & ".ods"
    If FileExists( sNeuDatei ) Then
       If MsgBox( "Die Datei existiert bereits!" & CHR(10) & _
             sNeuDatei & CHR(10) & _
             "Überschreiben?" , 36, _
             sMakroName & sMakroVersion ) = 7 THEN
             Exit Sub
       End If
    End If



    dim args3(1) as new com.sun.star.beans.PropertyValue
    args3(0).Name = "URL"
    args3(0).Value = sNeuDatei
    dispatcher.executeDispatch( document, ".uno:SaveAs", "", 0, args3())

    rem ----------------------------------------------------------------------
    dim args1(0) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "ToPoint"
    args1(0).Value = "$A$1:$G$63"

    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())


    ' Kopieren des Bereichs
    dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())


    rem ----------------------------------------------------------------------

    ' Einfügen der kopierten Daten

    args1(0).Name = "ToPoint"
    args1(0).Value = "$A$1"

    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())


    dim args2(5) as new com.sun.star.beans.PropertyValue
    args2(0).Name = "Flags"
    args2(0).Value = "SVDNT"
    args2(1).Name = "FormulaCommand"
    args2(1).Value = 0
    args2(2).Name = "SkipEmptyCells"
    args2(2).Value = false
    args2(3).Name = "Transpose"
    args2(3).Value = false
    args2(4).Name = "AsLink"
    args2(4).Value = false
    args2(5).Name = "MoveMode"
    args2(5).Value = 4

    dispatcher.executeDispatch( document, ".uno:InsertContents", "", 0, args2())
    
>>>rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "ToPoint"
args4(0).Value = "$I$1:$AC$468"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args4())

rem ----------------------------------------------------------------------
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = "Flags"
args5(0).Value = "A"

dispatcher.executeDispatch(document, ".uno:Delete", "", 0, args5())<<<

    rem ----------------------------------------------------------------------

    ' Löschen anderer Blätter

    aBlaetter = ThisComponent.Sheets().ElementNames
    For i = LBound( aBlaetter ) To UBound( aBlaetter )
       If NOT ( aBlaetter( i ) = sBlattBehalten ) Then
          ThisComponent.Sheets().removeByName( aBlaetter( i ) )
       End If
    Next i


    rem ----------------------------------------------------------------------

    ' automatisches Speichern
    ' ThisComponent.store()
	
>>>rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array())<<<

>>> davor und <<< hinter Änderung

Das Anfangsspeichern darf auf keine Fall passieren, hab ich gelöscht. dann löscht er noch nen paar Zeilen, die zum Ausfüllen dienten und speicherts zum schluss nochmal.

So werden jetzt aus 386 kb je Datei, 25 kb - was bei knapp 1200 Datein im Jahr doch eine gewissen Unterschied macht.

Ist gelöst. DANKE!

von **komma4** » So, 25.07.2010 04:12

Zum Frühstück die neueste Fassung

Änderungen:

neuer Makroname
Speichern der aktuellen Datei !
Speichern unter neuem Dateinamen (aus N4), dabei Abfrage beim Überschreiben, wenn bereits vorhanden
Einfügen der Werte unter "Verlust" der Formeln
Löschen der nicht benötigten Tabellenblätter: Blattname im Code anpassen!

Viel Erfolg!

Code: Alles auswählen

Sub Fixieren_und_Speichern
' Sub de39625
' 2010-07-23
' Kopieren eines definierten Bereich aus dem aktuellen Tabellenblatt 
' in eine neue Datei einfügen (Werte, nicht Formeln) 
' speichern unter einem Dateinamen, der aus Zelle N4 kommt
'
' 2010-07-25
' NEUER ABLAUF:
' Speichern der aktuellen Datei !
' Speichern unter neuem Dateinamen (aus N4)
' Abfrage beim Überschreiben
' Einfügen der Werte
' Löschen der nicht benötigten Tabellenblätter
' 


' Linux: vom root-Verzeichnis aus (ohne root-slash!), bspw. zentrale/daten
' Windows: bspw. d:/daten/2010/
CONST cVerzeichnis = "c:/asdf/"


' Name des Blattes, das ERHALTEN bleiben soll
CONST sBlattBehalten = "Aufstellung"


CONST sMakroName = "Fixieren und Speichern"
CONST sMakroVersion = " v1.0.0"


rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object




rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")



rem ----------------------------------------------------------------------

If ThisComponent.isModified() Then 
   ThisComponent.store()
End If


rem ----------------------------------------------------------------------

' Zusammensetzen des Dateinamens


sBlattName = document.Controller.ActiveSheet.Name
sZellwertN4 = _
ThisComponent.Sheets().getByName( sBlattName ).getCellRangeByName( "N4" ).String


rem ----------------------------------------------------------------------

' SpeichernAls: 

sNeuDatei = "file:///" & cVerzeichnis & sZellwertN4 & ".ods"
If FileExists( sNeuDatei ) Then
   If MsgBox( "Die Datei existiert bereits!" & CHR(10) & _
         sNeuDatei & CHR(10) & _
         "Überschreiben?" , 36, _
         sMakroName & sMakroVersion ) = 7 THEN
         Exit Sub
   End If
End If



dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = "URL"
args3(0).Value = sNeuDatei
dispatcher.executeDispatch( document, ".uno:SaveAs", "", 0, args3())









rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$1:$G$63"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())


' Kopieren des Bereichs
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())


rem ----------------------------------------------------------------------

' Einfügen der kopierten Daten

args1(0).Name = "ToPoint"
args1(0).Value = "$A$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())


dim args2(5) as new com.sun.star.beans.PropertyValue
args2(0).Name = "Flags"
args2(0).Value = "SVDNT"
args2(1).Name = "FormulaCommand"
args2(1).Value = 0
args2(2).Name = "SkipEmptyCells"
args2(2).Value = false
args2(3).Name = "Transpose"
args2(3).Value = false
args2(4).Name = "AsLink"
args2(4).Value = false
args2(5).Name = "MoveMode"
args2(5).Value = 4

dispatcher.executeDispatch( document, ".uno:InsertContents", "", 0, args2())


rem ----------------------------------------------------------------------

' Löschen anderer Blätter

aBlaetter = ThisComponent.Sheets().ElementNames
For i = LBound( aBlaetter ) To UBound( aBlaetter )
   If NOT ( aBlaetter( i ) = sBlattBehalten ) Then
      ThisComponent.Sheets().removeByName( aBlaetter( i ) )
   End If
Next i


rem ----------------------------------------------------------------------

' automatisches Speichern
' ThisComponent.store()

End Sub

von **komma4** » Fr, 23.07.2010 16:37

dcssd hat geschrieben:und geniese das verregnete Wochenende

[OT]
Es war zwar den ganzen Tag bedeckt, aber so richtig hat es schon eine Woche nicht mehr geregnet. Tageshöchttemperatur 35 Grad, nun (2135 Ortszeit) noch 30.
Und Wochenende gibt's auch nicht: hier ist durchgehend geöffnet.

Aber ich weiss schon, wie Du's meinst

Gleichfalls!
[/OT]

von **dcssd** » Fr, 23.07.2010 14:06

Wenn man die Datei erst speichert unter den Namen (N4) und dann alles löscht, würde die Ursprungsdatei unberührt bleiben und der Effekt wäre der gleiche.

Lass dir ruhig Zeit, ich hab jetzt auch Feierabend und geniese das verregnete Wochenende. Am Montag gehts weiter.
Schönes Wochenende bis dahin.

von **komma4** » Fr, 23.07.2010 13:21

Geht auch... (geht ja praktisch alles, was manuell machbar ist).

Ich sträube mich da eher grundsätzlich, da die Formeln zur Berechnung der Werte dadurch (unwiderruflich) verloren gehen.

Bin jetzt erstmal mit der Familie beim Abendessen.... irgendwann am Wochenende kommt noch was, versprochen

von **dcssd** » Fr, 23.07.2010 12:06

Hallo

Also das funktioniert soweit ganz gut bis ich die Einschränkungen gelesen hatte.

Zu den Einschränkungen:
* Ist egal, die Datei hat eine Endgröße von nun 20kb (Ausgangsdatei hat eine Größe von knapp 400 kb)
* Es wird "nie" passieren das ein Dateiname doppelt ist. Der Speichername setzt sich zusammen aus: Knd. Nr.-Abmessung-Menge-Datum (Seitdem ich hier arbeite hat kein Kunde am gleichen Tag die gleiche Menge des selben Produktes 2 mal gekauft.)
* Das ist ein ziemliches Problem. Da der Platz knapp ist passt dann nicht mehr alles auf ein A4 Blatt. (Auch die Seitenränder sind ja in einem neuem Dokument anders, auch schlecht)

Ich hab eben schon geschaut aber leider nichts gefunden wie man die Spalten bzw. Tabellen per Makro markiert. (Wenn man per Mausklick alles markiert (mit dem Ding links über A1) und das dann einfügt, behält er die Zellen- und Spaltenmaße bei.) Allerdings zeichnet er so was auch nicht in ein Makro mit auf, sondern lässt dann das markieren ganz weg und kopiert nur die Zelle die eben markiert ist.

Vielleicht würde es ja auch umgedreht funktionieren, z.Z. versuchen wir über den Weg ran zu gehen, die benötigten Daten zu kopieren und zu Speichern. Könnte es denn funktionieren die nicht mehr benötigten Tabellen zu löschen und nur die eine Tabelle dann zu speichern?

Würde zumindest das Formatierungsproblem sowie die Einstellung des Druckbereichs wegfallen lassen.

von **komma4** » Fr, 23.07.2010 09:56

dcssd hat geschrieben:Edit: nein hat nicht geklappt, eine nicht änderbare PDF wird nicht angenommen

Dann halt als Calc-Datei.

Der Einfachheit halber verwende ich hier eine aufgezeichnete und manuell erweiterte Programmierung

Code: Alles auswählen


Sub de39625
' 2010-07-23
' Kopieren eines definierten Bereich aus dem aktuellen Tabellenblatt 
' in eine neue Datei einfügen (Werte, nicht Formeln) 
' speichern unter einem Dateinamen, der aus Zelle N4 kommt


' Linux: vom root-Verzeichnis aus (ohne root-slash!), bspw. zentrale/daten
' Windows: bspw. d:/daten/2010/
CONST cVerzeichnis = "c:/asdf/"





rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$1:$G$63"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())


' Kopieren des Bereichs
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())


rem ----------------------------------------------------------------------

' Zusammensetzen des Dateinamens


sBlattName = document.Controller.ActiveSheet.Name
sZellwertN4 = _
ThisComponent.Sheets().getByName( sBlattName ).getCellRangeByName( "N4" ).String




rem ----------------------------------------------------------------------

' Neues Dokument aus Vorlage


Dim aDateiEigenschaft(0) As New com.sun.star.beans.PropertyValue

aDateiEigenschaft(0).Name = "AsTemplate"
aDateiEigenschaft(0).Value = True

oNeuDok = _
 StarDesktop.loadComponentFromURL( "private:factory/scalc", "_blank", 0, aDateiEigenschaft() ) 

oNeuDokFrame = oNeuDok.CurrentController.Frame





rem ----------------------------------------------------------------------

' Einfügen der kopierten Daten


dim args2(5) as new com.sun.star.beans.PropertyValue
args2(0).Name = "Flags"
args2(0).Value = "SVDNT"
args2(1).Name = "FormulaCommand"
args2(1).Value = 0
args2(2).Name = "SkipEmptyCells"
args2(2).Value = false
args2(3).Name = "Transpose"
args2(3).Value = false
args2(4).Name = "AsLink"
args2(4).Value = false
args2(5).Name = "MoveMode"
args2(5).Value = 4

dispatcher.executeDispatch( oNeuDokFrame, ".uno:InsertContents", "", 0, args2())





rem ----------------------------------------------------------------------

' Speichern


dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = "URL"
args3(0).Value = "file:///" & cVerzeichnis & sZellwertN4 & ".ods"

dispatcher.executeDispatch( oNeuDokFrame, ".uno:SaveAs", "", 0, args3())


End Sub

Anmerkungen und Einschränkungen:

* Je nach Layout der Calc-Standardvorlage sind noch andere (leere) Tabellenblätter im Dokument -ich denke, deren Speicherbedarf und daraus resultierende grössere Ladezeiten sind zu vernachlässigen
* Keine Fehlerbehandlung bei vorhandenem Dokument - es wird gnadenlos überschrieben
* Keine Übernahme der Spaltenbreiten

Kannst Du -können Deine Mitarbeiter- damit leben?

von **dcssd** » Do, 22.07.2010 14:05

Ja das wars, im Windows wird der Pfad mit \ angezeigt, deswegen hatte ichs so übernommen.

Vielen Dank für deine Mühe und Durchhaltevermögen

Jetzt muss ich nur noch die Mitarbeiter überzeugen das sie die einzelnen Datein zukünftig nichtmehr ändern können

Edit: nein hat nicht geklappt, eine nicht änderbare PDF wird nicht angenommen

von **komma4** » Do, 22.07.2010 13:46

Habe kein Windows... tippe auf fehlerhafte Verwendung des \

siehe Beispiel eine Zeile darüber

Code: Alles auswählen

c:/asdf/

War es das?

von **dcssd** » Do, 22.07.2010 13:43

Code: Alles auswählen

' Linux: vom root-Verzeichnis aus
' Windows: bspw. d:/daten/2010/
CONST cVerzeichnis = "c:\asdf\"
sub print_Calc2PDF
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$1:$G$63"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())

rem ----------------------------------------------------------------------
print "file:///" & cVerzeichnis & sZellwertN4 & ".pdf"

sBlattName = document.Controller.ActiveSheet.Name
sZellwertN4 = _
ThisComponent.Sheets().getByName( sBlattName ).getCellRangeByName( "N4" ).String



dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = "URL"
args3(0).Value = "file:///" & cVerzeichnis & sZellwertN4 & ".pdf"
args3(1).Name = "FilterName"
args3(1).Value = "calc_pdf_Export"

dispatcher.executeDispatch(document, ".uno:ExportDirectToPDF", "", 0, args3())

Damit Du nochmal siehst wo ichs eingefügt hab, hier nochmal schnell der code. (Ja der Ordner heißt so, der andere Pfad war mir zu lang, so hab ich alles kurzum dorthin kopiert)

Nach der Abfrage markiert er nochn bissl, bis wieder die Fehlermeldung kommt.

von **komma4** » Do, 22.07.2010 13:13

Bau mal die Zeile

Code: Alles auswählen

print "file:///" & cVerzeichnis & sZellwertN4 & ".pdf"

vor dem Speichern ein (BASIC-Editor offen lassen, Fehlerzeile wird gekennzeichnet.)

von **dcssd** » Do, 22.07.2010 13:09

naja sobald ichs ausführe,

er legt zumindest noch den Druckbereich fest (inner Druckvorschau gesehen)

von **komma4** » Do, 22.07.2010 12:17

Hä?

Habe eine solche Fehlermeldung noch nie gesehen... wo/wann kommt sie?

von **dcssd** » Do, 22.07.2010 11:58

okee das ging erstmal,
bis der nächste Fehler kam.. (langsam wirds peinlich das ich aber auch garnix über das zeug weiß

)

Fehler beim Speichern des Dokumentes Vorlage Prod
Die Operation auf \\.\ wurde mit einem ungültigen Parameter gestartet.

OpenOffice.info

einzelnes Tabellenblatt speichern, Dateiname generieren

Antwort erstellen

Ansicht erweitern Die letzten Beiträge des Themas: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren

Re: einzelnes Tabellenblatt speichern, Dateiname generieren