kopieren von Datei1 zu Datei2 (calc)

[felix]

Hallo,

ich habe mal wieder ein kleines Problem.
Ich versuche ein Makro zu schreiben, welches mir aus Datei1 eine Zelle kopiert, und in Datei2 in einer entsprechenden Zelle einfügt. Ich habe die bisherigen Ergebnisse mir aus dem Forum zusammen gesucht. Das Makro soll ausgeführt werden in Datei1.

Wenn ich nun den Code ausführe öffnet sich bei jedem ausführen, die Datei2. Auch wenn sie schon geöffnet ist. Ich hätte es gerne so, dass die Datei nur 1mal geöffnet wird, und wenn sie dann schon geöffnet sein sollte einfach der Inhalt aus Zelle X aus Datei1 in Datei2 Zelle Y schreibt.

ist das möglich und wenn ja wie?

Code: Alles auswählen

Sub Main
 x = ThisComponent.Sheets(0).getCellByPosition(0,0).string
 Dim Dokument as Object
 Dim sUrl as String
 Dim Dummy()
 sUrl = ConvertToUrl ("D:\Mein Pfad\Datei2.ods")
 Dokument = StarDesktop.loadComponentFromURL   ( sUrl , "_blank", 0, Dummy() )
 Dokument.Sheets(0).getCellByPosition(0,0).string = x
 Dokument.storeToUrl(sUrl,Dummy())
End Sub

Vielen Dank schon mal im Vorraus.

MfG Felix

[ykcim]

Hallo,

wenn Du ein Dokument öffnest, öffnet sich ein Dokument

Wenn Du zwischen zwei Dokumenten Daten austauschen willst mußt Du das Dokument nicht unbedingt neu öffnen.

Mit folgender Ergänzung kannst prüfen ob das Dokument schon offen ist.

Code: Alles auswählen

Sub Main
x = ThisComponent.Sheets(0).getCellByPosition(0,0).string
Dim Dokument as Object
Dim sUrl as String
Dim Dummy()
sUrl = ConvertToUrl ("D:\Mein Pfad\Datei2.ods")
'Prüfungsroutine
  gefunden=false
  oComponents = StarDesktop.getComponents()
  oDocs = oComponents.createEnumeration()
  Do While oDocs.hasMoreElements()
    oDoc = oDocs.nextElement()
    datei=odoc.geturl()
      if datei="D:\Mein Pfad\Datei2.ods" then 
         Dokument=odoc
         gefunden=true
     end if
  Loop
' Wenn nicht offen, dann öffnen 
 if gefunden=false then Dokument = StarDesktop.loadComponentFromURL   ( sUrl , "_blank", 0, Dummy() )
'Ende Prüfung 
 Dokument.Sheets(0).getCellByPosition(0,0).string = x
 Dokument.storeToUrl(sUrl,Dummy())
End Sub

(Code nur reingetippt nicht getestet!)

mfg
Michael

[felix]

Hallo,

zu erst Vielen Dank für die Antwort. Allerdings funktioniert das so nicht.

Wie würde der Code denn lauten, wenn dei Datei2 immer zusammen mit Datei1 geöffnet ist?
Ich würde gerne mal wissen, wie dieser "Grundbefehl" lautet.

MfG Felix

[ykcim]

Hallo,

der einzige blöde Fehler in meinem Schnell-Code war das vergessene ConvertToUrl:

Code: Alles auswählen

if datei=ConvertToUrl("D:\Mein Pfad\Datei2.ods") then 

Ansonsten funktioniert der Code.


mfg
Michael

[felix]

Hallo,

supi . Allerdings bekam ich noch einen Basic Laufzeitfehler, "Es ist eine Exception aufgetreten" und die Zeile

Code: Alles auswählen

Dokument.storeToUrl(sUrl,Dummy())

war blau hinterlegt. Ich habe diese dann Testweise gelöscht und es funzt wunderbar. Vielen Dank noch mal Michael.

so für die diesen Code auch noch mal nutzen wollen. So nutze ich ihn jetzt.

Code: Alles auswählen

Sub Test
x = ThisComponent.Sheets(0).getCellByPosition(0,0).string
Dim Dokument as Object
Dim sUrl as String
Dim Dummy()
sUrl = ConvertToUrl ("D:\Felix\Schützenverein\Auswertung\Abzeichen_Verwaltung.ods")
'Prüfungsroutine
  gefunden=false
  oComponents = StarDesktop.getComponents()
  oDocs = oComponents.createEnumeration()
  Do While oDocs.hasMoreElements()
    oDoc = oDocs.nextElement()
    datei=odoc.geturl()
     if datei=ConvertToUrl("D:\Felix\Schützenverein\Auswertung\Abzeichen_Verwaltung.ods") then 
         Dokument=odoc
         gefunden=true
     end if
  Loop
' Wenn nicht offen, dann öffnen
if gefunden=false then Dokument = StarDesktop.loadComponentFromURL   ( sUrl , "_blank", 0, Dummy() )
'Ende Prüfung
Dokument.Sheets(0).getCellByPosition(0,0).string = x
 
End Sub

bis denn.

Felix