Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex

Antwort erstellen

BBCode ist eingeschaltet
[img] ist ausgeschaltet
[url] ist eingeschaltet
Smileys sind ausgeschaltet
Die letzten Beiträge des Themas
   

Ansicht erweitern Die letzten Beiträge des Themas: Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex

Re: Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex

von Simon23 » Mo, 20.08.2007 15:58

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

Re: Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex

von Karolus » Mo, 20.08.2007 15:08

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

von Simon23 » Mo, 20.08.2007 14:27

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

von Simon23 » Sa, 18.08.2007 17:32

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?

von Simon23 » Sa, 18.08.2007 12:58

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

Cellbackcolor zwischen 2 Dokumenten kopieren und dann PDF ex

von Simon23 » Fr, 17.08.2007 17:39

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

Nach oben