von Toxitom » Di, 08.02.2022 15:20
Hey MagnaUser,
also, der Hinweis von mikeleb ist sehr gut und sollte beachtet werden. Wäre wahrscheinlich die bessere Lösung - falls die Dateien nicht mehr per Makro oder so ausgewertet werden....
Unabhängig davon hier mal der Rumpf-Code für das von Dir gewünschte Verfahren:
Code: Alles auswählen
REM ***** BASIC *****
Option explicit
Sub Datei_speichern()
DIM oDoc as variant, oSheet as variant
Dim oZielDoc as variant
Dim vntPathAndFile As String
dim arg(0) as new com.sun.star.beans.PropertyValue
REM Zugriff auf das aktuelle Dokument
oDoc = ThisComponent
REM Zugrif auf das aktuelle Tabellenblatt
oSheet = oDoc.CurrentController.ActiveSheet
REM Abfrage des Inhalts der einzelnen Zellen - Type 0 = leer
if oSheet.getCellRangeByName("T5").Type = 0 then
MsgBox "Keine Datum ausgewählt!"
Exit Sub
End If
REM hier die anderen Abfragen einpflegen
REM Zieldatei Pfad und Name
vntPathAndFile = convertToURL("D:\Stoerauswertung\" & Format(Now, "yyyy.mm.dd") & "_" & oSheet.getCellRangeByName("T6").string & "_" & "G26_TV" & ".ods")
REM Neue Calc-Datei erzeugen
Arg(0).Name = "Hidden"
Arg(0).Value = false ' nach Tests auf true setzen:))
oZielDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, arg())
oZielDoc.storeAsURL(vntPathAndFile, array())
REM jetzt aktuelles Tabellenblatt in neue Datei kopieren
CopyTabToNewDoc(oSheet, odoc, oZielDoc)
REM der Button sollte hier noch entfernt werden - sonst bleibt die Info, dass das Dokument Makros enthält - was aber nicht stimmt
REM Neues Dokument speichern und schliessen
With oZielDoc
.store()
.close(true)
end with
REM löschen der Inhalte der Zellen des Quelldokumentes
REM 1 = Werte, 2 = Datumwerte, 4 = Texte (Strings), 16 = Formeln
REM #### korrekten Werte einfügen und anpassen!!! ###
with oSheet
.getCellRangeByName("A1").clearContents(1+2+4+16)
.getCellRangeByName("D1:E1").clearContents(1+2+4+16)
end with
REM Cursor Ursprungsdokument auf Zelle
oDoc.CurrentController.Select(oSheet.getCellRangeByName("A1"))
REM Dokument speichern
oDoc.store()
end sub
'/** CopyTabToNewDoc
'*************************************************************************.
'* @kurztext kopiert ein übergebenes Tabellenblatt in eine andere Datei
'* Diese Funktion kopiert ein übergebenes Tabellenblatt einer Calc-Datei in eine
'* andere Calc-Datei, und zwar auf das Sheet(0) - also das erste Tabellenblatt
'*
'* @param1 oSheet as object Das zu kopierende Tabellenblatt als Objekt
'* @param2 oDoc as object Das Quelldokument
'* @param2 oZielDoc as object Das Zieldokument
'*
'* @return
'*************************************************************************
'*/
function CopyTabToNewDoc(oSheet as object, oDoc as object, oZielDoc as object)
DIM oFrame1 as variant, oFrame2 as variant
Dim oZelle as variant
Dim oDispatcher as variant
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oFrame1 = oDoc.CurrentController.Frame
REM Das zu kopierende Tabellenblatt wird markiert
oDoc.CurrentController.Select(oSheet)
REM Use a dispatch to copy to the clipboard.
oDispatcher.executeDispatch(oFrame1, ".uno:Copy", "", 0, Array())
REM Upper left corner of where to paste the data.
oZelle = oZielDoc.Sheets(0).getCellRangeByName("A1")
REM Place the view cursor there then paste the clipboard.
oZielDoc.CurrentController.Select(oZelle)
oFrame2 = oZielDoc.CurrentController.Frame
oDispatcher.executeDispatch(oFrame2, ".uno:Paste", "", 0, Array())
REM Cursor setzen in Zelle A1 des Zieldokumentes
oZielDoc.CurrentController.Select(oZelle)
end function
Funktioniert, musst Du halt noch entsprechend anpassen bzw. ergänzen.
Was nicht gut ist:
- Der Name der Zieldatei. Ich würde keine Punkte im Dateinamen akzeptieren - das Datum also entweder schreiben "JJJMMDD" oder statt Punkten Bindestriche nehmen.
- Eine Abfrage sollte eingebaut werden, ob die Zieldatei schon existiert - dann entsprechend Fehlermeldung oder so.
- Beim Kopieren des Tabellenblattes wird auch der Button mitkopiert - nicht aber das Makro. Der Button behält aber die Verbindung. Das Dokument glaubt also, dass noch ein Makro drin ist - entsprechende Abfrage... der sollte entfernt werden....
Ich würde das neue Dokument versteckt erzeugen - das ist praxisnäher:) Ändere nach den Tests den entsprechenden Wert von False auf true.
Arbeit nur mit einer Kopie deines Arbeitsdokumentes zum TEsten ... nicht, dass es evt. Kaputt geht
)
Viele Grüße
Tom
Hey MagnaUser,
also, der Hinweis von mikeleb ist sehr gut und sollte beachtet werden. Wäre wahrscheinlich die bessere Lösung - falls die Dateien nicht mehr per Makro oder so ausgewertet werden....
Unabhängig davon hier mal der Rumpf-Code für das von Dir gewünschte Verfahren:
[code]REM ***** BASIC *****
Option explicit
Sub Datei_speichern()
DIM oDoc as variant, oSheet as variant
Dim oZielDoc as variant
Dim vntPathAndFile As String
dim arg(0) as new com.sun.star.beans.PropertyValue
REM Zugriff auf das aktuelle Dokument
oDoc = ThisComponent
REM Zugrif auf das aktuelle Tabellenblatt
oSheet = oDoc.CurrentController.ActiveSheet
REM Abfrage des Inhalts der einzelnen Zellen - Type 0 = leer
if oSheet.getCellRangeByName("T5").Type = 0 then
MsgBox "Keine Datum ausgewählt!"
Exit Sub
End If
REM hier die anderen Abfragen einpflegen
REM Zieldatei Pfad und Name
vntPathAndFile = convertToURL("D:\Stoerauswertung\" & Format(Now, "yyyy.mm.dd") & "_" & oSheet.getCellRangeByName("T6").string & "_" & "G26_TV" & ".ods")
REM Neue Calc-Datei erzeugen
Arg(0).Name = "Hidden"
Arg(0).Value = false ' nach Tests auf true setzen:))
oZielDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, arg())
oZielDoc.storeAsURL(vntPathAndFile, array())
REM jetzt aktuelles Tabellenblatt in neue Datei kopieren
CopyTabToNewDoc(oSheet, odoc, oZielDoc)
REM der Button sollte hier noch entfernt werden - sonst bleibt die Info, dass das Dokument Makros enthält - was aber nicht stimmt
REM Neues Dokument speichern und schliessen
With oZielDoc
.store()
.close(true)
end with
REM löschen der Inhalte der Zellen des Quelldokumentes
REM 1 = Werte, 2 = Datumwerte, 4 = Texte (Strings), 16 = Formeln
REM #### korrekten Werte einfügen und anpassen!!! ###
with oSheet
.getCellRangeByName("A1").clearContents(1+2+4+16)
.getCellRangeByName("D1:E1").clearContents(1+2+4+16)
end with
REM Cursor Ursprungsdokument auf Zelle
oDoc.CurrentController.Select(oSheet.getCellRangeByName("A1"))
REM Dokument speichern
oDoc.store()
end sub
'/** CopyTabToNewDoc
'*************************************************************************.
'* @kurztext kopiert ein übergebenes Tabellenblatt in eine andere Datei
'* Diese Funktion kopiert ein übergebenes Tabellenblatt einer Calc-Datei in eine
'* andere Calc-Datei, und zwar auf das Sheet(0) - also das erste Tabellenblatt
'*
'* @param1 oSheet as object Das zu kopierende Tabellenblatt als Objekt
'* @param2 oDoc as object Das Quelldokument
'* @param2 oZielDoc as object Das Zieldokument
'*
'* @return
'*************************************************************************
'*/
function CopyTabToNewDoc(oSheet as object, oDoc as object, oZielDoc as object)
DIM oFrame1 as variant, oFrame2 as variant
Dim oZelle as variant
Dim oDispatcher as variant
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oFrame1 = oDoc.CurrentController.Frame
REM Das zu kopierende Tabellenblatt wird markiert
oDoc.CurrentController.Select(oSheet)
REM Use a dispatch to copy to the clipboard.
oDispatcher.executeDispatch(oFrame1, ".uno:Copy", "", 0, Array())
REM Upper left corner of where to paste the data.
oZelle = oZielDoc.Sheets(0).getCellRangeByName("A1")
REM Place the view cursor there then paste the clipboard.
oZielDoc.CurrentController.Select(oZelle)
oFrame2 = oZielDoc.CurrentController.Frame
oDispatcher.executeDispatch(oFrame2, ".uno:Paste", "", 0, Array())
REM Cursor setzen in Zelle A1 des Zieldokumentes
oZielDoc.CurrentController.Select(oZelle)
end function
[/code]
Funktioniert, musst Du halt noch entsprechend anpassen bzw. ergänzen.
Was nicht gut ist:
[list]Der Name der Zieldatei. Ich würde keine Punkte im Dateinamen akzeptieren - das Datum also entweder schreiben "JJJMMDD" oder statt Punkten Bindestriche nehmen. [/list]
[list]Eine Abfrage sollte eingebaut werden, ob die Zieldatei schon existiert - dann entsprechend Fehlermeldung oder so.[/list]
[list]Beim Kopieren des Tabellenblattes wird auch der Button mitkopiert - nicht aber das Makro. Der Button behält aber die Verbindung. Das Dokument glaubt also, dass noch ein Makro drin ist - entsprechende Abfrage... der sollte entfernt werden....[/list]
Ich würde das neue Dokument versteckt erzeugen - das ist praxisnäher:) Ändere nach den Tests den entsprechenden Wert von False auf true.
Arbeit nur mit einer Kopie deines Arbeitsdokumentes zum TEsten ... nicht, dass es evt. Kaputt geht ;))
Viele Grüße
Tom