OpenOffice.info

Hallo,

natürlich, das Speichern vergessen wie dumm. :roll:

Dankeschön. Funktioniert jetzt wunderbar. :lol:

Mit freundlichem Gruß
Felix

die schnelle Durchsicht Deines Codes zeigt mir das Schreiben des Datenarrays - und das anschliessende Schliessen der Datei, ohne dass Du diese gespeichert hättest.

Das kann dann nicht funktionieren, oder?

Sub EintragenT2

  a = ThisComponent.Sheets(4).GetCellRangeByName("Q211").value ' Zeilenindex (y-wert) für blauenbereich in Tab.Berechnung
  y = ThisComponent.Sheets(4).GetCellByPosition(11,a).value 'Y-Wert in tab.Eingaben
  x = ThisComponent.Sheets(4).GetCellByPosition(9,a).value 'Spaltenindex in tab.Eingaben
  
  oPfadAbzv = ThisComponent.Sheets(4).GetCellRangeByName("B32").string 'Pfad auslesen zur Abzeichenverwaltung
 
 Dim Dokument as Object
 Dim sUrl as String
 Dim Dummy(0) as new com.sun.star.beans.PropertyValue
 sUrl = ConvertToUrl (oPfadAbzv)
  
   'Prüfungsroutine
   gefunden=false
   oComponents = StarDesktop.getComponents()
   oDocs = oComponents.createEnumeration()
   Do While oDocs.hasMoreElements()
   oDoc = oDocs.nextElement()
   datei=odoc.geturl()
   if datei=ConvertToUrl(oPfadAbzv) then 
   Dokument=odoc
   gefunden=true
   end if
   Loop
    
 ' Wenn nicht offen, dann öffnen
 if gefunden=false then 
 
 Dummy(0).Name ="Hidden"
 Dummy(0).Value=TRUE
 Dokument = StarDesktop.loadComponentFromURL   ( sUrl , "_blank", 0, Dummy() )
 'Ende Prüfung
 
  aData1=ThisComponent.getSheets.getByIndex(4).getCellRangeByName("Q209").getDataArray()' Quelle (Datum eintragen)
  Dokument.getSheets.getByIndex(2).getCellByPosition(x,y).setDataArray(aData1()) ' Ziel
  
  aData2=ThisComponent.getSheets.getByIndex(4).getCellRangeByName("AC13").getDataArray()' Quelle (Ergebnis eintragen)
  Dokument.getSheets.getByIndex(2).getCellByPosition(x+1,y).setDataArray(aData2()) ' Ziel
 
  MsgBox("Abzeichen erfolgreich eingetragen", 48 ,"Abzeichen eintragen") 
 
  Dokument.Close(True)
 End if
 
 
 If gefunden = true Then
  Print "Offen"
  
  aData1=ThisComponent.getSheets.getByIndex(4).getCellRangeByName("Q209").getDataArray()' Quelle (Datum eintragen)
  Dokument.getSheets.getByIndex(2).getCellByPosition(x,y).setDataArray(aData1()) ' Ziel
  
  aData2=ThisComponent.getSheets.getByIndex(4).getCellRangeByName("AC13").getDataArray()' Quelle (Ergebnis eintragen)
  Dokument.getSheets.getByIndex(2).getCellByPosition(x+1,y).setDataArray(aData2()) ' Ziel
  
  'ThisComponent.Sheets(4).GetCellRangeByName("Q214").string = "1" 'Prüfgröße, auf 1 = Eingetragen setzen
  
  MsgBox("Abzeichen erfolgreich eingetragen", 48 ,"Abzeichen eintragen")  
 End IF

 
End Sub

Hallo,

Aufgabe des Makros Zellinhalte aus Datei1 in Datei2 zu schreiben. (beides Calc-Dateien)

Zuerst wird überprüft, ob die Datei2 bereits geöffnet ist, sollte dies der Fall sein wird die Datei2 nicht noch einmal geöffnet. Wenn die Datei2 noch nicht geöffnet ist soll sie "unsichtbar" also Hidden geöffnet werden. Wert eintragen, Datei2 wieder schließen.

Gehe ich von dem Fall aus die Datei2 ist noch nicht geöffnet, dann wird der Zellinhalt aus Datei1, wenn ich die Datei Hidden öffne, nicht eingetragen in Datei2.
Lasse ich den Punkt Datei2 Hidden zu öffnen weg und öffne Datei2 "normal" dann funktioniert alles wunderbar. Also die Zellinhalte aus Datei1 werden in Datei2 eingetragen.

Woran liegt das? Habe ich einen Fehler im Code? Ich bekomme auch keine Fehlermeldung oder ähnliches.

Ich nutze OO 2.3.1 unter WinVistaPremium

[code]Sub EintragenT2

a = ThisComponent.Sheets(4).GetCellRangeByName("Q211").value ' Zeilenindex (y-wert) für blauenbereich in Tab.Berechnung
y = ThisComponent.Sheets(4).GetCellByPosition(11,a).value 'Y-Wert in tab.Eingaben
x = ThisComponent.Sheets(4).GetCellByPosition(9,a).value 'Spaltenindex in tab.Eingaben

oPfadAbzv = ThisComponent.Sheets(4).GetCellRangeByName("B32").string 'Pfad auslesen zur Abzeichenverwaltung

Dim Dokument as Object
Dim sUrl as String
Dim Dummy(0) as new com.sun.star.beans.PropertyValue
sUrl = ConvertToUrl (oPfadAbzv)

'Prüfungsroutine
gefunden=false
oComponents = StarDesktop.getComponents()
oDocs = oComponents.createEnumeration()
Do While oDocs.hasMoreElements()
oDoc = oDocs.nextElement()
datei=odoc.geturl()
if datei=ConvertToUrl(oPfadAbzv) then
Dokument=odoc
gefunden=true
end if
Loop

' Wenn nicht offen, dann öffnen
if gefunden=false then

Dummy(0).Name ="Hidden"
Dummy(0).Value=TRUE
Dokument = StarDesktop.loadComponentFromURL ( sUrl , "_blank", 0, Dummy() )
'Ende Prüfung

aData1=ThisComponent.getSheets.getByIndex(4).getCellRangeByName("Q209").getDataArray()' Quelle (Datum eintragen)
Dokument.getSheets.getByIndex(2).getCellByPosition(x,y).setDataArray(aData1()) ' Ziel

aData2=ThisComponent.getSheets.getByIndex(4).getCellRangeByName("AC13").getDataArray()' Quelle (Ergebnis eintragen)
Dokument.getSheets.getByIndex(2).getCellByPosition(x+1,y).setDataArray(aData2()) ' Ziel

MsgBox("Abzeichen erfolgreich eingetragen", 48 ,"Abzeichen eintragen")

Dokument.Close(True)
End if


If gefunden = true Then
Print "Offen"

aData1=ThisComponent.getSheets.getByIndex(4).getCellRangeByName("Q209").getDataArray()' Quelle (Datum eintragen)
Dokument.getSheets.getByIndex(2).getCellByPosition(x,y).setDataArray(aData1()) ' Ziel

aData2=ThisComponent.getSheets.getByIndex(4).getCellRangeByName("AC13").getDataArray()' Quelle (Ergebnis eintragen)
Dokument.getSheets.getByIndex(2).getCellByPosition(x+1,y).setDataArray(aData2()) ' Ziel

'ThisComponent.Sheets(4).GetCellRangeByName("Q214").string = "1" 'Prüfgröße, auf 1 = Eingetragen setzen

MsgBox("Abzeichen erfolgreich eingetragen", 48 ,"Abzeichen eintragen")
End IF


End Sub[/code]

Mit freundlichem Gruß
Felix

Ps: die Prüfroutine ist nicht mein Werk. Siehe [url]http://de.openoffice.info/viewtopic.php?f=18&t=14558[/url].