Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex

[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

[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

[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

[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

[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
...

[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