Seite 1 von 1
Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex
Verfasst: Fr, 17.08.2007 17:39
von Simon23
Hallo,
die Aufgabe ist sicherlich nicht besonders schwierig zu erledigen:
Ich möchte ein Makro schreiben, dass in Calc die "Cellbackcolor" der Zellen von Dokument "TestA" zu Dokument "TestB" kopiert. Danach soll das Dokument "TestB" als PDF ausgegeben werden.
Ich möchte gar keine Lösung sondern nur eine kleine Hilfe...
Folgendes habe ich mir bislang überlegt:
Code: Alles auswählen
Sub Main
Dim sUrl1 as string
Dim sUrl2 as string
Dim Temp as string
Dim myProps(0) as New com.sun.star.beans.PropertyValue
sUrl1 = convertToURL("C:\TestB.ods")
sUrl2 = convertToURL("C:\TestC.ods")
oDoc1 = StarDesktop.loadComponentFromURL(sUrl1, "_blank", 0, myProps())
oDoc2 = StarDesktop.loadComponentFromURL(sUrl2, "_blank", 0, myProps())
x = 0
y = 0
while y < 10
while x < 10
oDoc2.sheets(0).getCellByPosition(x,y).Cellbackcolor(R,G,B)=oDoc1.sheets(0).getCellByPosition(x,y).Cellbackcolor(R,G,B)
x = x + 1
wend
y = y + 1
wend
End Sub
Es klappt allerdings leider nicht, was mache ich falsch? Oder gibt es einen eleganteren besseren Weg?
Vielen Dank
Simon
Re: Cellbackcolor zwischen 2 Dokumenten kopieren?
Verfasst: Sa, 18.08.2007 12:58
von Simon23
Ich habe den Fehler gefunden, ich x natürlich wieder auf 0 zurücksetzen:
Code: Alles auswählen
[...]
while y < 10
while x < 10
oDoc2.sheets(0).getCellByPosition(x,y).Cellbackcolor(R,G,B)=oDoc1.sheets(0).getCellByPosition(x,y).Cellbackcolor(R,G,B)
x = x + 1
wend
x = 0
y = y + 1
wend
Jetzt klappt es auch, ist halt nur nicht sonderlich elegant...
Es bleibt allerdings noch das Problem der PDF Ausgabe.
Ich habe unter
http://www.starbasicfaq.de/Wiekannmanmi ... l#Zweig134 schon nachgelesen, wie es gehen müsste, es klappt aber noch nicht.
Code: Alles auswählen
Sub Main
Dim sUrl1 as string
Dim sUrl2 as string
Dim Temp as string
Dim myProps(0) as New com.sun.star.beans.PropertyValue
Dim x as Integer
Dim y as Integer
sUrl1 = convertToURL("C:\TestB.ods")
sUrl2 = convertToURL("C:\TestC.ods")
oDoc1 = StarDesktop.loadComponentFromURL(sUrl1, "_blank", 0, myProps())
oDoc2 = StarDesktop.loadComponentFromURL(sUrl2, "_blank", 0, myProps())
x = 0
y = 0
while y < 10
while x < 10
oDoc2.sheets(0).getCellByPosition(x,y).Cellbackcolor(R,G,B)=oDoc1.sheets(0).getCellByPosition(x,y).Cellbackcolor(R,G,B)
x = x + 1
wend
x = 0
y = y + 1
wend
' Jetzt als PDF speichern
DIM sUrl as string
Dim myProps2(0) as New com.sun.star.beans.PropertyValue
sUrl = convertToURL("C:\Test.pdf")
myProps2(0).Name="FilterName"
myProps2(0).Value = "writer_pdf_Export"
oDoc2.storetoUrl(sUrl,myProps2())
End Sub
Für eine kleine Hilfe wäre ich sehr dankbar.
Simon
Re: Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex
Verfasst: Sa, 18.08.2007 17:32
von Simon23
So, ich habe nach vielen Versuchen endlich ein lauffertiges Programm:
Code: Alles auswählen
REM ***** BASIC *****
Sub Main
Dim sUrl1 as string
Dim sUrl2 as string
Dim Temp as string
Dim myProps(0) as New com.sun.star.beans.PropertyValue
Dim x as Integer
Dim y as Integer
DIM i as Integer
sUrl1 = convertToURL("C:\TestB.ods")
sUrl2 = convertToURL("C:\TestC.ods")
oDoc1 = StarDesktop.loadComponentFromURL(sUrl1, "_blank", 0, myProps())
oDoc2 = StarDesktop.loadComponentFromURL(sUrl2, "_blank", 0, myProps())
i = 0
x = 0
y = 0
while i < 5
y = (100 * i)
while y < ((i*100) + 100) 'Man muss hier bis 100 gehen, zur Demo auch kürzer --> Gibt die Zeilentiefe an!
while x < 100
oDoc2.sheets(0).getCellByPosition(x,y-(100*i)).Cellbackcolor(R,G,B)=oDoc1.sheets(0).getCellByPosition(x,y).Cellbackcolor(R,G,B)
x = x + 1
wend
x = 0
y = y + 1
wend
' Jetzt speichern
DIM dummy()
DIM datei as string
DIM filename as string
filename = i
datei="c:\Temp\" + i + ".ods"
dateiurl=converttourl(datei)
odoc2.storeasurl(dateiurl,dummy())
'odoc1.close(true)
'odoc2.close(true)
i = i + 1
wend
End Sub
Nun werde ich versuchen mit Hilfe des schon fertigen Makros von
http://www.goermezer.de/content/view/424/538/ die Dateien aus dem Ordner Temp in PDFs umzuwandeln.
Simon
Re: Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex
Verfasst: Mo, 20.08.2007 14:27
von Simon23
Hallo nochmal,
wenn ich versuche die Hintergrundfarbe einer einzelnen Zelle zu kopieren, dann klappt das mit diesem Code wunderbar:
Code: Alles auswählen
Sub Main
Dim sUrl1 as string
Dim sUrl2 as string
Dim Temp as string
Dim myProps(0) as New com.sun.star.beans.PropertyValue
sUrl1 = convertToURL("C:\TestB.ods")
sUrl2 = convertToURL("C:\TestC.ods")
oDoc1 = StarDesktop.loadComponentFromURL(sUrl1, "_blank", 0, myProps())
oDoc2 = StarDesktop.loadComponentFromURL(sUrl2, "_blank", 0, myProps())
oDoc2.sheets(0).getCellRangeByName("A1:A1").Cellbackcolor=oDoc1.sheets(0).getCellRangeByName("A1:A1").Cellbackcolor
End Sub
Code: Alles auswählen
oDoc2.sheets(0).getCellRangeByName("A1:A20").Cellbackcolor=oDoc1.sheets(0).getCellRangeByName("A1:A20").Cellbackcolor
Wenn ich den Zellbereich allerdings von A1:A1 auf A1:A20 erweitere, dann klappt es nicht mehr.
Was mache ich falsch?
Es handelt sich übrigens um diese Dokumente (Bei "TestC" habe ich die Felder extra rot eingefärbt, um zu kontrollieren, ob das Makro klappt):
http://wwwhomes.uni-bielefeld.de/smeier8/TestB.ods
http://wwwhomes.uni-bielefeld.de/smeier8/TestC.ods
Simon
Simon
Re: Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex
Verfasst: Mo, 20.08.2007 15:08
von Karolus
Hallo
Verwende ....getCellbyPosition(...) und pack das in eine Schleife, zb.:
Code: Alles auswählen
....
for z = 0 to 19 'Zeile 1 bis 20
oDoc2.sheets(0).getCellbyPosition(0,z).Cellbackcolor=oDoc1.sheets(0).getCellByPosition(0,z).Cellbackcolor
next z
...
Re: Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex
Verfasst: Mo, 20.08.2007 15:58
von Simon23
Hi,
genauso hatte ich das vorher auch. Das ist aber total langsam, ich brauche zum Kopieren einer Tabelle 10 Minuten und habe insgesamt 100 Tabellen. Kann man die Farbe nur aus einzelnen Zellen kopieren?
Simon