Calc Makro zum befüllen einer Liste

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: Calc Makro zum befüllen einer Liste

Re: Calc Makro zum befüllen einer Liste

von SIRE.de » Di, 27.07.2010 22:28

Funktioniert einwandfrei!!! Perfekt!!! Hab noch ein "JumpToTable" eingebaut, dann ist es egal in welcher Mappe die Zieldatei geschlossen wurde.

Nochmal herzlichsten Dank!

Gruß
Thomas

Re: Calc Makro zum befüllen einer Liste

von SIRE.de » Di, 27.07.2010 19:22

Werd es sofort ausprobieren! VIELEN DANK für deine Mühe!!!

Re: Calc Makro zum befüllen einer Liste

von komma4 » Di, 27.07.2010 19:18

In diesem Fall war auch die Formatierung wichtig... Du hast mit zusammengefassten Zellen gearbeitet, und ich hab's übersehen. :oops:
(Hatte auch noch einen Fehler in der Positionierung auf dem Zielblatt... hat ziemlich gedauert, bis ich es gesehen habe).


Diese Variante funktioniert mit hier mit Deinen Testdateien... probier es mal aus.

Code: Alles auswählen

Sub de40593

' Zugriff auf die Datei
oDok = ThisComponent

' Zugriff auf Rahmen
oFrame = oDok.CurrentController.Frame

' Zugriff auf Blatt
'oBlatt = oDok.Sheets().getByName( "Aufstellung" )
oBlatt = oDok.Sheets().getByName( "IIS" )

' Suchbereich definieren
oBereich = oBlatt.getCellRangeByName( "A2:A1000" )

' Suchobjekt
oSuchen = oBereich.createSearchDescriptor()
' gesucht wird...
oSuchen.SearchString = "Halb"

' Suche ausführen und Fund-Adresse besetzen
oGefundenAdresse = oBereich.findFirst( oSuchen ).CellAddress
' Index der Zeile
' print oGefundenAdresse.Row

' Kopieren
sKopierBereich = _
 "$B$" & oGefundenAdresse.Row + 4 & ":" & _
 "$H$" & oGefundenAdresse.Row + 4


dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = sKopierBereich


dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

dispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, args1() )
dispatcher.executeDispatch( oFrame, ".uno:Copy", "", 0, Array() )

' ------------------------------------------------------------------

' Zugriff auf Zieldatei




' sPfad = "/zentrale/daten/2010/test/de40593_Ziel.ods"
sPfad = "C:/IIS/IIS_Daten.ods"
sUrl = ConvertToUrl( sPfad )

oDokZiel = StarDesktop.loadComponentFromUrl( sUrl, "_blank", 0, Array() )
oDokZielFrame = oDokZiel.CurrentController.Frame

oZielBlatt = oDokZiel.Sheets().getByName( "IIS HALBZEUG" )


oCursor = oZielBlatt.createCursor()
oCursor.gotoStartOfUsedArea( False )
oCursor.gotoEndOfUsedArea( True )
aAdresse = oCursor.getRangeAddress()

' dort einfügen
sEinfuegePos = "$B$" & aAdresse.Endrow + 2  

dim args2(1) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
args2(0).Value = sEinfuegePos 

dispatcher.executeDispatch( oDokZielFrame, ".uno:GoToCell", "", 0, args2() )


dim args11(1) as new com.sun.star.beans.PropertyValue
args11(0).Name = "Flags"
args11(0).Value = "SVDT"


dispatcher.executeDispatch( oDokZielFrame, ".uno:InsertContents", "", 0, args11() ) 


End Sub
Bin für heute mal weg...hier ist Mitternacht vorbei :)

Re: Calc Makro zum befüllen einer Liste

von SIRE.de » Di, 27.07.2010 18:37

Bin noch mitten drin und versuchs immer noch zu raffen. :D
Hoffe meine Laienhafften bis stümperhaften Versuche bisher sind keine zu große Qual für dich.
Aber super nett, dass du drüberschaust!!

Re: Calc Makro zum befüllen einer Liste

von komma4 » Di, 27.07.2010 18:33

SIRE.de hat geschrieben:Wenn ich ehrlich bin steig ich noch nicht ganz durch, was du gemacht hast ...
1. Solltest Du (hier) immer ehrlich sein :)
2. hoffe ich, genau das gemacht zu haben, was Du vorhast.

Ich schau' mir's an.... Formatierung ist etwas, was nach der Funktion kommt :D

Re: Calc Makro zum befüllen einer Liste

von SIRE.de » Di, 27.07.2010 18:27

Wenn ich ehrlich bin steig ich noch nicht ganz durch, was du gemacht hast ...

Ich häng mal die Dateien an, damit es deutlicher wird, was ich meine / vor habe.
Das Layout ist noch unschön und wird noch.
Später soll es für alle Teile gehen. Angefangen hab ich mit den "Halbzeugen"

Versuch mal weiter noch durch deinen Code zu steigen ...

Vielen Dank schonmal für deine Bemühungen!

Gruß
Thomas
Dateianhänge
IIS_Daten.ods
(12.25 KiB) 66-mal heruntergeladen
Fertigung.ods
Eingabemaske
(18.95 KiB) 74-mal heruntergeladen

Re: Calc Makro zum befüllen einer Liste

von komma4 » Di, 27.07.2010 18:15

Willkommen im Forum.


Habe mal versucht Deine Angaben umzusetzen.
Hoffentlich habe ich die Positionen richtig beschrieben... schau mal, ob Du damit was anfangen kannst.

Die Schleifen zum Finden der Zeilen habe ich mit einem Suchobjekt neu gestaltet.
Das Kopieren bleibt dem DISPATCHER überlassen....

Code: Alles auswählen

Sub de40593

' Zugriff auf die Datei
oDok = ThisComponent

' Zugriff auf Rahmen
oFrame = oDok.CurrentController.Frame

' Zugriff auf Blatt
oBlatt = oDok.Sheets().getByName( "Aufstellung" )

' Suchbereich definieren
oBereich = oBlatt.getCellRangeByName( "A2:A1000" )

' Suchobjekt
oSuchen = oBereich.createSearchDescriptor()
' gesucht wird...
oSuchen.SearchString = "Halb"

' Suche ausführen und Fund-Adresse besetzen
oGefundenAdresse = oBereich.findFirst( oSuchen ).CellAddress
' Index der Zeile
' print oGefundenAdresse.Row

' Kopieren
sKopierBereich = _
 "$B$" & oGefundenAdresse.Row + 2 & ":" & _
 "$B$" & oGefundenAdresse.Row + 5


dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = sKopierBereich


dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

dispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, args1() )
dispatcher.executeDispatch( oFrame, ".uno:Copy", "", 0, Array() )

' ------------------------------------------------------------------

' Zugriff auf Zieldatei



' sPfad = "/zentrale/daten/2010/test/de40593_Ziel.ods"

sPfad = "C:/IIS/IIS_Daten.ods"
sUrl = ConvertToUrl( sPfad )

oDokZiel = StarDesktop.loadComponentFromUrl( sUrl, "_blank", 0, Array() )
oDokZielFrame = oDokZiel.CurrentController.Frame

oZielBlatt = oDokZiel.Sheets().getByName( "IIS_HALBZEUG" )

' Suchen der Einfügemarke
oBereich = oZielBlatt.getCellRangeByName( "A2:A1000" )

' Suchobjekt
oSuchen = oBereich.createSearchDescriptor()
' gesucht wird...
oSuchen.SearchString = "0"

' Suche ausführen und Fund-Adresse besetzen
oGefundenAdresse = oBereich.findFirst( oSuchen ).CellAddress

' zwei zeilen darunter einfügen
sEinfuegePos = "$A$" & oGefundenAdresse.Row + 3  

args1(0).Name = "ToPoint"
args1(0).Value = sEinfuegePos 

dispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, args1() )


dim args11(5) as new com.sun.star.beans.PropertyValue
args11(0).Name = "Flags"
args11(0).Value = "SVDT"
args11(1).Name = "FormulaCommand"
args11(1).Value = 0
args11(2).Name = "SkipEmptyCells"
args11(2).Value = false
args11(3).Name = "Transpose"
args11(3).Value = false
args11(4).Name = "AsLink"
args11(4).Value = false
args11(5).Name = "MoveMode"
args11(5).Value = 4

dispatcher.executeDispatch( oDokZielFrame, ".uno:InsertContents", "", 0, args11() ) 


End Sub
Kommst Du damit zurecht? Fragen? Fragen!

Calc Makro zum befüllen einer Liste

von SIRE.de » Di, 27.07.2010 17:13

Hallo zusammen!

Versuch mich seit heute morgen um 8Uhr an einer (hoffentlich) simplen Aufgabe.

Ich habe zwei Calc Tabellen. Eine dient als einfache "Eingabemaske", die zweite als "Speicherort".
Der Speicherort heisst "IIS_Daten.ods" und besitzt zahlreiche Mappen.

Bisher hab ich folgenden Code zusammengebracht.
Kurzzusammenfassung was bisher passiert:
Zuerst gehts in der Eingabemaske runter bis zu den zu kopirenden Zellen
Es werden vier Zellen kopiert.
Die Daten Datei wird geöffnent
In der Entsprechenden Mappe geht es solange runter bis ans Ende der Liste

Dann soll der Inhalt eingefügt werden. Und genau das klappt nicht!
"dispatcher.executeDispatch(Sheet, ".uno:InsertContents", "", 0, args11())"
wenn ich "Sheet" durch "document" ersetze ist, wird der Inhalt in der Eingabemaske eingefügt. So kommt es zur Fehlermeldung.

IIS_Daten wird gespeichert und wieder geschlossen.

Code: Alles auswählen

REM  *****  BASIC  *****

Sub Main

dim Halb as string
Halb = "Neues Halbzeug abspeichern"

rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
args2(0).Value = "$A$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2())


rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "By"
args3(0).Value = 1
args3(0).Name = "Sel"
args3(0).Value = false

rem ----------------------------------------------------------------------

PosZeile = 0

oDoc = thisComponent
mySheet = oDoc.Sheets().getByName("IIS")
Do Until mySheet.getcellbyPosition(0,PosZeile).string = Halb
dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args3())

Poszeile = Poszeile + 1
loop

rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "By"
args4(0).Value = 1
args4(0).Name = "Sel"
args4(0).Value = false

dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args4())


rem ab hier

rem ----------------------------------------------------------------------
dim args5(1) as new com.sun.star.beans.PropertyValue
args5(0).Name = "By"
args5(0).Value = 1
args5(1).Name = "Sel"
args5(1).Value = true

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args5())

rem ----------------------------------------------------------------------
dim args6(1) as new com.sun.star.beans.PropertyValue
args6(0).Name = "By"
args6(0).Value = 1
args6(1).Name = "Sel"
args6(1).Value = true

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args6())

rem ----------------------------------------------------------------------
dim args7(1) as new com.sun.star.beans.PropertyValue
args7(0).Name = "By"
args7(0).Value = 1
args7(1).Name = "Sel"
args7(1).Value = true

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args7())

rem ----------------------------------------------------------------------
dim args8(1) as new com.sun.star.beans.PropertyValue
args8(0).Name = "By"
args8(0).Value = 1
args8(1).Name = "Sel"
args8(1).Value = true

dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args8())


rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())


rem ----------------------------------------------------------------------
dim args11(5) as new com.sun.star.beans.PropertyValue
args11(0).Name = "Flags"
args11(0).Value = "SVDT"
args11(1).Name = "FormulaCommand"
args11(1).Value = 0
args11(2).Name = "SkipEmptyCells"
args11(2).Value = false
args11(3).Name = "Transpose"
args11(3).Value = false
args11(4).Name = "AsLink"
args11(4).Value = false
args11(5).Name = "MoveMode"
args11(5).Value = 4

rem ----------------------------------------------------------------------

Dim Pfad as String
Dim Dummy()
Dim Url as String
Dim Calc as Object
Dim Sheet as Object
Dim Zelle as Object


Pfad = "file:///C:/IIS/IIS_Daten.ods"
Url = ConvertToUrl(Pfad)
Calc = StarDesktop.loadComponentFromUrl(Url, "_blank",0,Dummy())
Sheet = Calc.sheets("IIS HALBZEUG")


rem hier geht es in Halbzeug runter

Poszeile2 = 1

rem #oDoc2 = thisComponent
rem #mySheet2 = oDoc2.Sheets().getByName("IIS HALBZEUG")

Do Until Sheet.getcellbyPosition(0,Poszeile2).value = "0"

dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args3())
Poszeile2 = Poszeile2 + 1
loop
rem dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args3())
Zelle = Sheet.getCellbyPosition(0,Poszeile2)

dispatcher.executeDispatch(Sheet, ".uno:InsertContents", "", 0, args11())  

rem Zelle.String = "Test hat geklappt" 
rem #dispatcher.executeDispatch(oDoc2, ".uno:InsertContents", "", 0, args11())

If (Calc.isModified) then ' Calc-Doku speichern, wenn geändert
Calc.store()
End if
Calc.close(0)

End Sub
Über Hilfe würde ich mich sehr freuen ...

Mit freundlichen Grüßen
Thomas

Nach oben