Makro gesucht

[Markus M.]

Hallo,

Ich bin blutiger Anfänger in der Programmierung von Makros.

Ich hoffe jemand kann mir hier bei meinem Problem weiterhelfen.

Ich habe 2 zwei Calc-Dateien.
Die Namen der Calc-Dateien lauten Datensaetze.ods und Themen.ods

Die Dateien sind folgendermaßen aufgebaut:
1. Datensaetze.ods:
- für jeden Monat gibt es ein eigenes Tabellenblatt, also insgesamt 12.
- Die Datei dient dazu Ereignisse in chronologischer Reihenfolge aufzulisten.
- Dabei entspricht ein Ereignis einer Zeile
- Ein Ereignis besteht aus folgenden Datenfeldern: fortlaufender Nummer, Datum, Themengebiet, Ereignis-Beschreibung

2. Themen.ods
- In diese Datei sollen alle Ereignisse aus der Datei Datensaetze.ods eingefügt werden.
- Hier gibt es aber für jedes Themengebiet ein eigenes Tabellenblatt.
- Es gibt aber keine feste Anzahl von vordefinierten Themengebieten wie in der Datensaetze.ods.
- Am Ende (5 Zeilen Abstand zum letzten Ereignis) jeden Tabellenblattes befindet sich eine Zeile, in der die aktuelle Anzahl der Ereignisse wiedergegeben wird.


folgendes soll das Makro können:
- selbständig erkennen in welchen Tabellenblättern von Datensaetze.ods neue Ereignisse hinzugekommen sind
*erledigt* auslesen des Themengebietes von den neuen Ereignissen
*erledigt* diese Ereignisse sollen dann von Datensaetze.ods in Themen.ods kopiert werden;
*erledigt* und zwar in das Tabellenblatt mit dem passenden Themengebiet
*erledigt* sollte das Themengebiet noch nicht als Tabellenblatt in Themen.ods vorhanden sein, dann soll automatisch ein neues Tabellenblatt mit dem passenden Namen erstellt werden
- für jedes neu kopierte Ereignis in Themen.ods soll in dem passenden Tabellenblatt unter dem letzten Ereignis eine neue Zeile mit dem kopierten Inhalt eingefügt werden, damit die Zeile mit der Angabe der aktuellen Anzahl der Ereignisse immer als abschließende Zeile in jedem Tabellenblatt von Themen.ods erscheint

*folgende Funktion wäre cool, muss das Makro aber nicht zwingend können:
- nach jedem Kopiervorgang wird als Feedback für den Nutzer, das kopierte Ereignis grün hinterlegt

Grüße

der Markus

[Toxitom]

Hey Markus,

na, für einen Anfänger hast du dir aber ein "tolles" Projekt vorgenommen. Aber - man wächst ja mit den Aufgaben

Nun habe ich aber keine "echte " Frage aus deinem Thread herausgelesen - höchstens "Wer schreibt mir das Makro"?
Nur, das ist wohl nicht die Aufgabe des Userforums. Wir helfen gerne - bei Punkten, wo du nicht weiterkommst, bei Detailfragen, sicher auch mal bei einer Routine oder so. Aber ob dir jemand die komplette Applikation schreibt??
Also, erwarte nicht zuviel, setze dich selbst dran und frage, wenn du nicht weiterkommst. Poste deinen Gedankengang, deinen bisherigen Code und eventuelle Fehlermeldungen - dann bekommst du sicher konkrete und fundierte Hilfe

Und jetzt - viel Spass beim Beginnen.

Viele Grüße
Thomas

[Markus M.]

hi Thomas,

ok. Ich nehme deine Aufforderung zum Anlass und fang mal mit meinem Gedankengang an...

Wichtig wäre demnach zu allererst eine Kopierfunktion, die generell Zeilen von einem Tabellenblatt in ein Anderes kopieren kann.

Folgende Codezeilen hab ich im Forum gefunden und angepasst, die dies für ein Dokument erledigen können:

Code: Alles auswählen

Sub kopieren1

dim aDat()
oDoc = thisComponent
mySheet1 = oDoc.Sheets().getByName("monat")
mySheet2 = oDoc.Sheets().getByName("ereignis")

oBereich1 = mySheet1.getCellRangeByName("A3:D3")
aDat = oBereich1.getDataArray()
oBereich2 = mySheet2.getCellRangeByName("A3:D3")
oBereich2.setDataArray(aDat())

End Sub

Der nächste Schritt würde dann darin bestehen, den Kopiervorgang zu erweitern auf 2 Dateien:

Code: Alles auswählen

function fnOpenDoc(sFile)
sURL = ConvertToURL(sFile)
fnOpenDoc = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, Array())
end function 

Sub kopieren2

dim aDat()
oDoc1= thisComponent
oDoc2 = fnOpenDoc("C:\******\Themen.ods")


mySheet1 = oDoc1.Sheets().getByName("monat")
mySheet2 = oDoc2.Sheets().getByName("ereignis")

oBereich1 = mySheet1.getCellRangeByName("A3:D3")
aDat = oBereich1.getDataArray()
oBereich2 = mySheet2.getCellRangeByName("A3:D3")
oBereich2.setDataArray(aDat())

End Sub

funktionieren tut bei mir bis jetzt alles noch.
Aber ein kleines Problem hab ich dann doch:
Wenn Themen.ods noch geöffnet ist, und ich kopieren2 in Datensaetze.ods aufrufe, dann bekomme ich folgenden Basic-Laufzeitfehler:
"Es ist eine Exception aufgetreten
Type: com.sun.star.container.NoSuchElementException
MEssage:."
Was muss ich im Code anpassen, damit der Laufzeitfehler nicht mehr erscheint?

Das solls für heute erst einmal sein. Als nächstes wollte ich mich mal daran versuchen die statische Datei-URL dadurch zu ersetzen, dass der Stammordner von oDoc1 (oDoc1.url) ausgelesen wird und dann an den Funktionsauruf fnOpenDoc von oDoc2 übergeben wird...

Gruss

der Markus

[Markus M.]

Hallo,

so hier kommt nun die vierte Version meines Kopier-Makros:
Was hab ich geändert?
- automatisches auslesen des Speicherpfads vom ersten Dokument und Übergabe der URL an die Funktion zum öffnen vom zweiten Dokument.
- kopieren von kompletten Zeilen
- Themengebiet des Ereignisses auslesen und als Argument an oDoc2.Sheets().getByName übergeben

Code: Alles auswählen

function fnOpenDoc(sFile)
sURL = ConvertToURL(sFile)
fnOpenDoc = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, Array())
end function 

Code: Alles auswählen

Sub kopieren4
GlobalScope.BasicLibraries.LoadLibrary("Tools") 
dim aDat()
Dim themengebiet as Object
 
oDoc1= thisComponent
adresse = ConvertFromUrl (oDoc1.url)
pfad = DirectoryNameOutOfPath(adresse, "\") 

oDoc2 = fnOpenDoc(pfad & "\Themen.ods")

mySheet1 = oDoc1.Sheets().getByName("monat")

themengebiet = mySheet1.getCellByPosition(7,2)

mySheet2 = oDoc2.Sheets().getByName(themengebiet.String)

oBereich1 = mySheet1.Rows(2)
aDat = oBereich1.getDataArray()
oBereich2 = mySheet2.Rows(2)
oBereich2.setDataArray(aDat())
End Sub

Was kommt als nächstes?
- automatisches Einfügen eines neuen Tabellenblattes in Themen.ods mit dem Themengebiet als Tabellennamen, welches noch nicht in Themen.ods existiert.

Bis jetzt läuft nämlich der Kopiervorgang nur reibungslos ab, wenn das Themengebiet als Tabellenblatt in Themen.ods schon existiert.

Die Methode um ein neues Tabellenblatt zu erzeugen lautet: oDoc2.Sheets.insertNewByName( themengebiet.String, 0 )

Aber wie verknüpfe ich das Ganze in eine vernüftige if-Verzweigung, dass nur noch dann ein neues Tabellenblatt angelegt werden soll, wenn es noch nicht existiert?

Wer hilft mir auf die Sprünge?

Gruss

Der Markus

[kannenklaus]

hallo markus,

eine vernüftige if-Verzweigung, dass nur noch dann ein neues Tabellenblatt angelegt werden soll, wenn es noch nicht existiert?

so müßte es klappen:

Code: Alles auswählen

If oDoc2.Sheets.hasByName("Themengebiet")=false then oDoc2.Sheets.insertNewByName( themengebiet.String, 0 )

grüße

klaus

[Markus M.]

Hallo Klaus,

danke für den Geistesblitz, genau wie ich es haben wollte

So damit würde ich zur mittlerweile 5 Version meines Kopier-Makros kommen.

Was hab ich diesmal neues drin im Code?
- ermitteln des gerade in Bearbeitung befindlichen Tabellenblattes und der dazugehörigen aktiven Zelle
- die aktive Zeile wird kopiert
- Es wird das jeweilige Themengebiet der gerade aktiven Zeile genommen
- Eine Schleife ist hinzugekommen, die in dem passenden Tabellenblatt von Themen.ods ermitteln soll, wo sich die nächste unbeschriebene Zeile befindet

Hier der aktuelle Code:

Code: Alles auswählen

function fnOpenDoc(sFile)
sURL = ConvertToURL(sFile)
fnOpenDoc = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, Array())
end function

Code: Alles auswählen

Sub kopieren5
GlobalScope.BasicLibraries.LoadLibrary("Tools") 
Dim themengebiet as Object
Dim iRun As Integer
Dim n As Integer
 
oDoc1= thisComponent
adresse = ConvertFromUrl (oDoc1.url)
pfad = DirectoryNameOutOfPath(adresse, "\") 

mysheet1=oDoc1.currentcontroller.activesheet
Zellaktuell=oDoc1.getCurrentSelection().getCellAddress()
oRow=Zellaktuell.Row
oColumn=Zellaktuell.column

oDoc2 = fnOpenDoc(pfad & "\Themen.ods")

themengebiet = mySheet1.getCellByPosition(7,oRow)

If oDoc2.Sheets.hasByName(themengebiet.String)=false then 
oDoc2.Sheets.insertNewByName( themengebiet.String, 0 )
end if

mySheet2 = oDoc2.Sheets().getByName(themengebiet.String) 

iRun = 0
n = 0

do while n <> 14
inhalt = mySheet2.getCellByPosition(0,iRun).String
If inhalt = ""  then
n = 14
Else 
iRun = iRun + 1
End If
loop



oBereich1 = mySheet1.Rows(oRow)
aDat = oBereich1.getDataArray()
oBereich2 = mySheet2.Rows(iRun)
oBereich2.setDataArray(aDat())

End Sub

Welche Probleme traten diesmal auf?
- Wie lautet die Funktion, die eine leere Zeile nach/vor eine bestehende Zeile einfügt?

Als nächstes werde ich mich mit folgender Sache beschäftigen:
- selbständiges erkennen in welchen Tabellenblättern von Datensaetze.ods neue Ereignisse hinzugekommen sind

Bei diesem Punkt hab ich momentan gar keine Ahnung wie ich das machen soll, deshalb hab ich es bis zum Schluss aufgehoben

Ich denke mal am "einfachsten" ist es, wenn man jedesmal automatisch das Makro oder besser den Teil des Makros mit der Kopierfunktion starten lässt, sobald das aktuelle Ereignis in eine Zeile eingegeben wurde.

Also müsste man wieder eine If-Verzweisung schreiben, die "reagiert", ergo den Kopiervorgang startet, sobald der Nutzer in der aktiven Zeile z.B. an Spalte 12 ankommt.

Geht bzw. funktioniert das so, wie ich es geschildert habe oder gehts sogar noch einfacher?


Gruss

Markus

[Karolus]

Hallo Markus
Folgendes ist mir aufgefallen:

Code: Alles auswählen

iRun = 0
n = 0
do while n <> 14
inhalt = mySheet2.getCellByPosition(0,iRun).String
If inhalt = ""  then
n = 14
Else
iRun = iRun + 1
End If
loop 

wieso die Abfrage nach n<>14 ?
reicht hier nicht:

Code: Alles auswählen

 iRun = 0 
while mySheet2.getCellByPosition(0,iRun).String <> ""
iRun = iRun + 1
wend

- selbständiges erkennen in welchen Tabellenblättern von Datensaetze.ods neue Ereignisse hinzugekommen sind

Bei diesem Punkt hab ich momentan gar keine Ahnung wie ich das machen soll, deshalb hab ich es bis zum Schluss aufgehoben

Es gibt da doch eine fortlaufende Nummerierung, evtl. könntest du diese in einer Schleife abfragen, ob schon im Zieldokument vorhanden ?

Gruß Karo

[Markus M.]

Hallo,

danke Karo, hab deinen Verbesserungsvorschlag eingebaut.

Bin gerade dabei eine SuchFunktion in den Code einzubauen, bekomme aber jedesmal beim starten des Makros und aufrufen der Suchfunktion einen Laufzeitfehler, das eine Objektvariable nicht belegt ist.

im Makro rufe ich die Funktion so auf

Code: Alles auswählen

zellkopf = textInZellebereichSuchen("Themengebiet")

Code: Alles auswählen

Function textInZellebereichSuchen (suchwort)
	' Variablen deklarieren
	Dim oZelleOderBereichOderBlatt as Object
	Dim oSuchBeschreibung as Object
	Dim oTrefferZelle as Object
	Dim findewort as String
	
	' Zellbereich holen in dem ersetzt werden soll
	oZelleOderBereichOderBlatt = thisComponent.currentcontroller.activesheet
	
	' SearchDescriptor erzeugen
	oSuchBeschreibung = oZelleOderBereichOderBlatt.createSearchDescriptor()	
		
	' SearchDescriptor konfigurieren
	With oSuchBeschreibung
		.SearchString = suchwort
		.SearchBackwards = False
		.SearchCaseSensitive = True
		.SearchWords = True
		.SearchRegularExpression = False
		.SearchStyles = False
		.SearchSimilarity = False
		.SearchSimilarityRelax = True
		.SearchSimilarityRemove = 2
		.SearchSimilarityAdd = 2
		.SearchSimilarityExchange = 2
	End With
	
	' nach erster Trefferzelle suchen
	oTrefferZelle = oZelleOderBereichOderBlatt.findFirst( oSuchBeschreibung )
		
		MsgBox "Treffer in Zelle " & oTrefferZelle.CellAddress.Column & "/" & oTrefferZelle.CellAddress.Row
		
End Function

Wer sieht den Fehler?

Gruss

Markus

[Toxitom]

Hey Markus,

also, in dem Code gibt es keinen Fehler. Läuft bei mir einwandfrei

Aber wenn du die Meldung bekommst, so bleibt der Compiler doch in der entsprechenden Zeile Stehen - und die ist nun markiert. So findest du doch dein "Objekt" sehr schnell

Gruss
Thomas

<edit> Ahh, doch etwas: Wenn dein Suchwort nicht gefunden wird, ist natürlich dein Objekt "oTrefferZelle" nicht definiert - hier wird es eine Fehlermeldung geben, wenn du diese dann las Basis für die Spalte/Zeile nutzt. Das geht ja nicht
Musst du über eine If-Bedingung abfangen.

[Markus M.]

Hallo Thomas,

eine Frage, was "ist" eigentlich zellkopf, wenn ich mein Funktion ausführe? Ein Zahlenwert? Ein Object? ...

Code: Alles auswählen

zellkopf = textInZellebereichSuchen("Themengebiet")

Folgendes wollte ich eigentlich mit dem Funktionsaufruf erreichen:
- zellkopf soll die Zelladresse von oTrefferZelle übernehmen

Habe mit Karos Hilfe zusätzlich noch einige Zeilen zu meiner Funktion hinzugefügt.

Code: Alles auswählen

function textInZellebereichSuchen(suchwort)
   ' Variablen deklarieren
   Dim oZelleOderBereichOderBlatt as Object
   Dim oSuchBeschreibung as Object
   Dim oTrefferZelle as Object
   'suchwort = "suchmich"
   ' Zellbereich holen in dem ersetzt werden soll
   odoc = ThisComponent
   oZelleOderBereichOderBlatt = odoc.currentcontroller.activesheet
   
   ' SearchDescriptor erzeugen
   oSuchBeschreibung = oZelleOderBereichOderBlatt._
      createSearchDescriptor()
     
   ' SearchDescriptor konfigurieren
   With oSuchBeschreibung
      .SearchString = suchwort
      .SearchBackwards = False
      .SearchCaseSensitive = True
      .SearchWords = True
      .SearchRegularExpression = False
      .SearchStyles = False
      .SearchSimilarity = False
      .SearchSimilarityRelax = True
      .SearchSimilarityRemove = 2
      .SearchSimilarityAdd = 2
      .SearchSimilarityExchange = 2
   End With
   
   ' nach erster Trefferzelle suchen
   oTrefferZelle = oZelleOderBereichOderBlatt._
      findFirst( oSuchBeschreibung )
'__________
     oCelle=oTrefferzelle.getCellAddress()
      ' aktuelle Zeile, Index
         aRow=oCelle.Row
        '  aktuelle Spalte, Index
         aColumn=oCelle.column
         msgbox(acolumn & "sp" & arow & "z") 
'_____________
End function

die Messagebox liefert mir dann z.B. folgendes: "6sp1z"

Habe dann mal zu Kontrollzwecken folgende Codezeile nach dem Funktionsaufruf eingefügt

Code: Alles auswählen

msgbox (aColumn & aRow)

aber in dem Fenster was mir dann angezeigt wird, haben aColumn & aRow keine Werte mehr!
Dabei macht es keinen Unterschied, ob ich nun die Funktion wie oben aufrufe oder so:

Code: Alles auswählen

textInZellebereichSuchen("Themengebiet")

Beide Male scheint es als ob die Werte verloren gehen!

wenn ich dann aber alternativ folgendes versuche:

Code: Alles auswählen

msgbox (zellkopf.Row & zellkopf.column)

Nur das liefert mir wieder nur einen Laufzeitfehler, weil angeblich die Objectvariable(n) zellkopf.Row & zellkopf.column nicht belegt sind????

Wie bekomme ich es hin, dass die Werte von aColumn und aRow nicht mehr verloren gehen?

Gruss

Markus

[Stephan]

eine Frage, was "ist" eigentlich zellkopf, wenn ich mein Funktion ausführe? Ein Zahlenwert? Ein Object? ...

zellkopf = textInZellebereichSuchen("Themengebiet")

das ist (allgemein) der Rückgabewert der Funktion, den Du jedoch nicht enthälst weil innerhalb der Funktion kein Ergebnis übergeben wird. Du kannst z.B. Dieses tun:

Code: Alles auswählen

function textInZellebereichSuchen(suchwort) 
'...
    oCelle=oTrefferzelle.getCellAddress() 
      ' aktuelle Zeile, Index 
         aRow=oCelle.Row 
        '  aktuelle Spalte, Index 
         aColumn=oCelle.column 
         msgbox(acolumn & "sp" & arow & "z") 
'_____________ 
textInZellebereichSuchen = oCelle
End function

dann ist zellkopf ein Objekt und es liefert:

Code: Alles auswählen

zellkopf = textInZellebereichSuchen("Themengebiet")
msgbox (zellkopf.Row & zellkopf.column)

das gewünschte Ergebnis.



Gruß
Stephan

[Toxitom]

Hey Markus,

...was "ist" eigentlich zellkopf, wenn ich mein Funktion ausführe?...

So, wie es jetzt darsteht - nix. Die funktion kann normalerweise einen Rückgabewert liefern, nur musst du den auch zuweisen. Da das bei dir nicht der Fall ist, ist "Zellkopf" eine undefinierte Variable ohne Inhalt.

also, korrrekt müsste es so lauten:

Code: Alles auswählen

...
zellkopf = textInZellebereichSuchen("Themengebiet")
...
function textInZellebereichSuchen(suchwort) 
....

  textInZellebereichSuchen = acolumn & "sp" & arow & "z"
end function

Jetzt wäre "zellkopf" eine Stringvariable mit dem Inhalt "6sp1z" um bei deinem Beispiel zu bleiben.

Habe dann mal zu Kontrollzwecken folgende Codezeile nach dem Funktionsaufruf eingefügt

Logisch. aColumn und aRow waren variable, die nur innerhalb der Funktion textInZellebereichSuchen definiert waren und auch nur dort sichtbar sind. Sollten sie überall sichtbar sein, so musst du sie als globale Variable vor der ersten Sub/Funcktion des Moduls definieren, also ganz am Anfang.

Wäre aber vom Programmfluss nicht schön. Nutze den Rückgabewert der Funktion!

Viele Grüße
Thomas

[Karolus]

Hallo Markus
Die Code-zeilen 'msgBox(...'
waren doch nur zur Kontrolle

Um eine gefundene Zelladresse der Function zurückzugeben, brauchst du als 2.letzte Codezeile in der Function:

Code: Alles auswählen

....
textInZellebereichSuchen = oTrefferzelle.getCellAddress()
end function

Es wäre evtl. hilfreich wenn du mal den gesamten Makrocode posten würdest mit ein paar Erklärungen was du im Detail ereichen willst.

gruß Karo

[Markus M.]

Abend zusammen,

so poste jetzt mal den aktuellen Code des Makros. Ist diesmal auch auskommentiert.

nochmals Danke für die Erleuchtungen, die ihr mit euren Anworten mir liefert

Code: Alles auswählen

function fnOpenDoc(sFile)
sURL = ConvertToURL(sFile)
fnOpenDoc = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, Array())
end function 

function textInZellebereichSuchen(suchwort,dokument)
   ' Variablen deklarieren
   Dim oZelleOderBereichOderBlatt as Object
   Dim oSuchBeschreibung as Object
   Dim oTrefferZelle as Object
   
  If dokument = "oDoc1" Then
   odoc = ThisComponent
   oZelleOderBereichOderBlatt = odoc.currentcontroller.activesheet
 
   ' SearchDescriptor erzeugen
   oSuchBeschreibung = oZelleOderBereichOderBlatt._
      createSearchDescriptor()
     
   ' SearchDescriptor konfigurieren
   With oSuchBeschreibung
      .SearchString = suchwort
      .SearchBackwards = False
      .SearchCaseSensitive = True
      .SearchWords = True
      .SearchRegularExpression = False
      .SearchStyles = False
      .SearchSimilarity = False
      .SearchSimilarityRelax = True
      .SearchSimilarityRemove = 2
      .SearchSimilarityAdd = 2
      .SearchSimilarityExchange = 2
   End With
   
   ' nach erster Trefferzelle suchen
   oTrefferZelle = oZelleOderBereichOderBlatt._
      findFirst( oSuchBeschreibung )
'__________
     oCelle=oTrefferzelle.getCellAddress()
      ' aktuelle Zeile, Index
         aRow=oCelle.Row
        '  aktuelle Spalte, Index
         aColumn=oCelle.column
'_____________
textInZellebereichSuchen = aColumn
  End If

  If dokument = "oDoc2" Then
   oDoc1= thisComponent
   adr = ConvertFromUrl (oDoc1.url)
   pfad = DirectoryNameOutOfPath(adr, "\")
   odoc = fnOpenDoc(pfad & "\Themen.ods")
   oZelleOderBereichOderBlatt = odoc.Sheets().getByName("blanko")

 ' SearchDescriptor erzeugen
   oSuchBeschreibung = oZelleOderBereichOderBlatt._
      createSearchDescriptor()
     
   ' SearchDescriptor konfigurieren
   With oSuchBeschreibung
      .SearchString = suchwort
      .SearchBackwards = False
      .SearchCaseSensitive = True
      .SearchWords = True
      .SearchRegularExpression = False
      .SearchStyles = False
      .SearchSimilarity = False
      .SearchSimilarityRelax = True
      .SearchSimilarityRemove = 2
      .SearchSimilarityAdd = 2
      .SearchSimilarityExchange = 2
   End With
   
   ' nach erster Trefferzelle suchen
   oTrefferZelle = oZelleOderBereichOderBlatt._
      findFirst( oSuchBeschreibung )
'__________
     oCelle=oTrefferzelle.getCellAddress()
      ' aktuelle Zeile, Index
         aRow=oCelle.Row
        '  aktuelle Spalte, Index
         aColumn=oCelle.column
'_____________
textInZellebereichSuchen = aColumn
 
'schliessen
odoc.close(true)
' Wartezeit einfügen, um einen exposedexecption zu vermeiden
wait(100)
End If
End Function


Sub kopieren6

' Variablen deklarieren
GlobalScope.BasicLibraries.LoadLibrary("Tools") 
Dim themengebiet as Object
Dim iRun As Integer
Dim n As Integer
Dim arg() 

'ermitteln des Speicherpfads von oDoc1 
oDoc1= thisComponent
adresse = ConvertFromUrl (oDoc1.url)
pfad = DirectoryNameOutOfPath(adresse, "\") 

'ermitteln der gerade aktiven Zeile, Spalte, Tabellenblatt und Zelle
mysheet1=oDoc1.currentcontroller.activesheet
Zellaktuell=oDoc1.getCurrentSelection().getCellAddress()
oRow=Zellaktuell.Row
oColumn=Zellaktuell.column

'Auslesen der Spalten aus oDoc1 mit den Bezeichnungen
lNummer = textInZellebereichSuchen("Nr.","oDoc1")
lThemengebiet = textInZellebereichSuchen("Themengebiet","oDoc1")
lDatum = textInZellebereichSuchen("Datum","oDoc1")
lText = textInZellebereichSuchen("Text","oDoc1")

'Auslesen der Spalten aus oDoc2 mit den Bezeichnungen
rNummer = textInZellebereichSuchen("Nr.","oDoc2")
rThemengebiet = textInZellebereichSuchen("Themengebiet","oDoc2")
rDatum = textInZellebereichSuchen("Datum","oDoc2")
rText = textInZellebereichSuchen("Text","oDoc2")

'Aus der der gerade aktiven Zeile in oDoc1 die Zelle auswählen mit der passenden Spaltenbezeichnung
themengebiet = mySheet1.getCellByPosition(lThemengebiet,oRow)
nummer = mySheet1.getCellByPosition(lNummer,oRow)
datum = mySheet1.getCellByPosition(lDatum,oRow)
beschreibung = mySheet1.getCellByPosition(lText,oRow)

'öffnen von oDoc2
oDoc2 = fnOpenDoc(pfad & "\Themen.ods")

'falls Tabellenblatt mit gesuchtem Tabellennamen noch nicht existiert, wird eins erstellt
If oDoc2.Sheets.hasByName(themengebiet.String)=false then 
oDoc2.Sheets.insertNewByName( themengebiet.String, 0 )
end if

mySheet2 = oDoc2.Sheets().getByName(themengebiet.String) 

'Schleife, welche die nächste freie Zeile in oDoc2 sucht
iRun = 0
while mySheet2.getCellByPosition(0,iRun).String <> ""
iRun = iRun + 1
wend

'Kopierfunktion
'die Zellen in oDoc2 ermitteln, in die der Inhalt aus oDoc1 kopiert werden soll
oBereich1 = mySheet2.getCellByPosition(rThemengebiet,iRun)
oBereich2 = mySheet2.getCellByPosition(rNummer,iRun)
oBereich3 = mySheet2.getCellByPosition(rDatum,iRun)
oBereich4 = mySheet2.getCellByPosition(rText,iRun)

'Kopieren des Inhalts
oBereich1.String = themengebiet.String
oBereich2.String = nummer.String
oBereich3.String = datum.String
oBereich4.String = beschreibung.String



' Änderungen in oDoc2 speichern 
Call oDoc2.store()

'schliessen von oDoc2
wait(1000)
oDoc2.close(true)
End Sub

Bestimmt rümpfen jetzt einige bei der SuchFunktion mit den doppelten Code die Nase, habs aber leider anders nicht hinbekommen, ohne Syntax-Fehler zu produzieren...
Wenn jemand Ideen hat den Code zu optimieren oder zu kürzen, nur zu

Dann noch eine Sache zum dem Problem mit dem Laufzeitfehler, wenn noch eine ältere Instanz von Themen.ods geöffnet ist:
könnte man nicht eine Anweisung in den Code einbauen, die vor dem Öffnen von Themen.ods nachprüft, ob ältere Instanzen noch geöffnet sind und diese notfalls ohne nachzufragen abspeichert und schließt?

der Code zum schließen und abspeichern von Dokumenten habe ich zwar schon in das Makro eingebaut, leider weiss ich folgendes nicht:
1. Wie ermittele ich, ob gerade ein bestimmtes Dokument geöffnet ist, welches ich nicht über das Makro geöffnet habe?
2. Wie bekomme ich dann die URL dieses geöffneten Dokumentes heraus, damit ich es abspeichern und schliessen kann?

Gruss

Markus

[Stephan]

1. Wie ermittele ich, ob gerade ein bestimmtes Dokument geöffnet ist, welches ich nicht über das Makro geöffnet habe?
2. Wie bekomme ich dann die URL dieses geöffneten Dokumentes heraus, damit ich es abspeichern und schliessen kann?

Ist jetzt schon etwas spät (oder wahlweise etwas früh ), aber der folgende Code demonstriert das im Prinzip, Du müßtest nur das Überflüssige entfernen. Das Schließen ist aber nicht nötig, es sei denn es wäre für Deinen Code nötig. Ansonsten kannst Du direkt mit dem aus dem untenstehenden Makro rückgegebenen Dokumentobjekt weiterarbeiten.
Wenn Du das nicht allen schaffst frage nochmal, morgen (oder heute) bin ich ausgeschlafener.

Code: Alles auswählen

sub gesamt
'hier Dateinamen vorgeben
gesuchter_dateiname = "post.sxw"
'----------------------------------------
laenge = Len(gesuchter_dateiname)
alles = StarDesktop.getComponents()
elemente = alles.createEnumeration()
Do While elemente.HasMoreElements
   aktuell = elemente.NextElement()
   If HasUnoInterfaces( aktuell, "com.sun.star.frame.XModel" ) Then
      If aktuell.hasLocation() Then 
          if Right(ConvertFromURL(aktuell.GetLocation),laenge) = gesuchter_dateiname Then
             if Right(ConvertFromURL(aktuell.GetLocation),3) ="sxc" Then
                'Beispiel Calc
                blatt = aktuell.getSheets().GetByName("Tabelle1")
                zelle = blatt.getCellByPosition(0, 0)
                zelle.Value = 12345
             end if
             if Right(ConvertFromURL(aktuell.GetLocation),3) ="sxw" Then
                'Beispiel Writer
                Cursor = aktuell.Text.createTextCursor()
                Cursor.String = "Das ist ein Beispieltext"
             end if
          end if
      end if
   end if
Loop
end sub

Gruß
Stephan