OpenOffice.info

Verfasst: **Mo, 03.10.2011 16:50**

Hallo,

ich habe mal wieder ein Problem mit einem Makro.
Ich habe mir aus einem Forum schon einmal ein Makro kopiert welches perfekt funktioniert.
Dieses Makro importiert in eine geöffnete Datei Daten aus einer anderen Calc Datei.

Nun möchte ich gerne eine aus der geöffneten Datei Daten in eine andere Calc Datei exportieren.
Wenn es diese Datei noch nicht gibt soll diese automatisch erstellt werden.

Ich habe schon seit Tagen versucht das import Makro umzuschreiben aber leider bekomme ich nur Fehlermeldungen aber kein funktionierendes Makro.

Ich vermute das es relativ simpel ist aber ich bin leider am Ende mit meinen Ideen.

Kann mir vielleicht jemand dabei helfen oder einen Lösungsansatz nennen.

Nachfolgend das Makro und schon einmal vielen Dank für die Hilfe im voraus.

Code: Alles auswählen

sub Dateb_importieren



    Dim sPath, fullPath, iVal, iResult As String
    Dim r  as Integer
    Dim oDocument, thisDoc, oSheet, ocell1, oVal, oSrcRange, oDstRange as Object




    
    CRBP_L = 0
    CRBP_O = 0 
    CRBP_R = 11 
    CRBP_U = 3000 

    sPath = ThisComponent.getSheets().getByName( "Tabelle2").getCellRangeByName( "a1" ).getString() & getpathseparator 'Ort der die Dateien enthält >> Pfad anpassen!
    r = 1 'Startwert Zeile setzen
    sFileName = Dir$(sPath & getPathSeparator() & "*", 0)
'    Do
      fullPath = converttourl(sPath & sFileName)
      sFileName = Dir$
      
      
                  if FILEEXISTS (fullPath) = false then 
msgbox "Unter dem angegebenen Pfad wurden keine Kontoauszugsdaten gefunden. Bitte überprüfen Sie ob unter dem angegebenen Pfad (in Zeile 2) die Datei wirklich gespeichert wurde." ,64, "Belege importieren"
exit sub
endif
      
      dim myFileProp(0) as New com.sun.star.beans.PropertyValue
      myFileProp(0).name = "Hidden"
      myFileProp(0).value = true
      oDocument = StarDesktop.loadComponentFromURL(fullPath, "_blank", 0, myFileProp())

      
      oSheet = oDocument.sheets(0) 
      oSrcRange = osheet.getCellRangeByPosition(CRBP_L,CRBP_O,CRBP_R,CRBP_U) 
      oDataArray = oSrcRange.getDataArray

      thisDoc = thisComponent 
      oSheet = thisDoc.sheets(0)
      oDstRange = osheet.getCellRangeByPosition(CRBP_L,CRBP_O,CRBP_R,CRBP_U)
      oDstRange.setDataArray(oDataArray)
    
      redim myFileProp
      oDocument.close(true) 

end sub

Verfasst: **Mo, 03.10.2011 19:08**

12dis02424 hat geschrieben:Ich habe schon seit Tagen versucht das import Makro umzuschreiben aber leider bekomme ich nur Fehlermeldungen aber kein funktionierendes Makro.

Ich vermute das es relativ simpel ist aber ich bin leider am Ende mit meinen Ideen.

Was hast Du schon probiert?
Welche Fehlermeldungen kommen, an welchen Stellen?

Du hast mit den Anweisungen .getDataArray und .setDataArray schon die wichtigsten Befehle.

Verfasst: **Mo, 03.10.2011 19:33**

Hallo,

ich hatte versucht die Bereiche "umzudrehen" damit das Makro erst in der geöffneten Datei arbeitet und dann in der Zieldatei.

Dies habe ich so versucht

Code: Alles auswählen

      
thisDoc = thisComponent 
oSheet = thisDoc.sheets(0)
oSrcRange = osheet.getCellRangeByPosition(CRBP_L,CRBP_O,CRBP_R,CRBP_U) 
oDataArray = oSrcRange.getDataArray

oSheet = oDocument.sheets(0) 
oDstRange = osheet.getCellRangeByPosition(CRBP_L,CRBP_O,CRBP_R,CRBP_U)
oDstRange.setDataArray(oDataArray)

dann habe ich noch versucht

oDocument = StarDesktop.loadComponentFromURL

in

oDocument = StarDesktop.saveComponentFromURL

zu verändern.
Und noch einige Dinge die ich jetzt nicht mehr nachvollziehen kann.
Die Fehlermeldungen kann ich jetzt nicht mehr rekontruieren da ich die einzelnen Schritte nicht einzeln abgespeichert habe und immer wieder neu versucht habe.

Gruß Norman

Verfasst: **Mo, 03.10.2011 20:24**

Der Code zum kopieren sieht schonmal gut aus.

Zuvor musst Du prüfen, ob Deine Zieldatei vorhanden ist (Laufzeitfunktion: FileExists) und öffnen, oder eine neue, leere erstellen.

Code: Alles auswählen

sNeuUrl = "private:factory/scalc"
oDocument = _
 StarDesktop.loadComponentFromURL(  sNeuUrl ,  "_blank" ,  0 ,  Array() )

Der Befehl zum Speichern einer vorhandenen Datei lautet .store(), der zum Speichern der neu erstellten

Code: Alles auswählen

sURL = ConvertToURL ("/zentrale/2011/testdata/neueCalcdatei.ods")
oDocument.storeToURL( sURL, Array() )

Kommst Du damit weiter?

Verfasst: **Mi, 05.10.2011 19:45**

Hallo,

ich bin zu blöd.
Ich habe vorher schon viele Dinge hinbekommen wie autom. E-Mail versenden, Datein versenden, aus und einblenden von Sheets pdf auf Desktop abspeichern usw. aber hier dran scheiter ich.

Ich hatte es jetzt mit diesem Code versucht.

Fehlanzeige

Code: Alles auswählen

   sub Datei_exportieren




    Dim sPath, fullPath, iVal, iResult As String
    Dim r  as Integer
    Dim oDocument, thisDoc, oSheet, ocell1, oVal, oSrcRange, oDstRange as Object




   
    CRBP_L = 0
    CRBP_O = 0 
    CRBP_R = 11 
    CRBP_U = 3000 

    sPath = "c:\Dokumente und Einstellungen\user\Desktop\test.ods"
    r = 1 'Startwert Zeile setzen
    sFileName = Dir$(sPath & getPathSeparator() & "*", 0)
'    Do
      fullPath = converttourl(sPath & sFileName)
      sFileName = Dir$
      
      
                  if FILEEXISTS (fullPath) = false then 

sNeuUrl = "c:\Dokumente und Einstellungen\user\Desktop\Test.ods"
oDocument = StarDesktop.loadComponentFromURL(  sNeuUrl ,  "_blank" ,  0 ,  Array() )


endif



      dim myFileProp(0) as New com.sun.star.beans.PropertyValue
      myFileProp(0).name = "Hidden"
      myFileProp(0).value = true
      oDocument = StarDesktop.loadComponentFromURL(fullPath, "_blank", 0, myFileProp())

   
   thisDoc = thisComponent 
oSheet = thisDoc.sheets(0)
oSrcRange = osheet.getCellRangeByPosition(CRBP_L,CRBP_O,CRBP_R,CRBP_U) 
oDataArray = oSrcRange.getDataArray


oSheet = oDocument.sheets(0) 
oDstRange = osheet.getCellRangeByPosition(CRBP_L,CRBP_O,CRBP_R,CRBP_U)
sURL = ConvertToURL ("c:\Dokumente und Einstellungen\user\Desktop\test.ods")
oDocument.storeToURL( sURL, Array() )


    
      redim myFileProp
      oDocument.close(true) 'Quelldokument schliessen
'    Loop Until sFileName = ""

end sub

Kannst du mir bitte noch einen Tip geben.

Danke
Norman

Verfasst: **Mi, 05.10.2011 20:58**

12dis02424 hat geschrieben:Kannst du mir bitte noch einen Tip geben.

Ich gebe Dir gleich mehrere:

Kommentiere Deinen Code.
Damit können andere besser nachvollziehen was Du vorhast und Du kannst es auch einige Zeit später besser lesen.
überprüfe die Schritte Deiner Codierung, durch MSGBOX Ausgaben, mittels XRAY oder MRI
Erwartest Du, dass ich (oder andere hier) Deine Situation nachstellen, sich Testdaten erzeugen und Dein Programm debuggen?
Wenn etwas nicht klappt, dann poste doch bitte auch die Fehlermeldungen oder Fehlreaktionen des Programms.
Und die Stelle des Fehlverhaltens.

Sorry - ich weiss aktuell nicht mal, von welcher Datei Du wohin kopieren willst...

Verfasst: **Sa, 08.10.2011 11:36**

Hallo,

so habs jetzt doch noch selbst hin bekommen.
Danke für den Denkanstoß !!!

Code: Alles auswählen

sub Datei_exportieren

    Dim sPath, fullPath, iVal, iResult As String
    Dim r  as Integer
    Dim oDocument, thisDoc, oSheet, ocell1, oVal, oSrcRange, oDstRange as Object




    ' Start und Endposition fuer CellRangeByPosition festlegen
    CRBP_L = 0 ' CellRangeByPosition Links      Spalte 
    CRBP_O = 0 ' CellRangeByPosition Oben      Zeile 
    CRBP_R = 27 ' CellRangeByPosition Rechts   Spalte 
    CRBP_U = 20000 ' CellRangeByPosition Unten   Zeile 801
    
    thisDoc = thisComponent 
oSheet = thisDoc.sheets(0)
oSrcRange = osheet.getCellRangeByPosition(CRBP_L,CRBP_O,CRBP_R,CRBP_U) 
oDataArray = oSrcRange.getDataArray
    
    
    
url=converttourl("c:\Dokumente und Einstellungen\user\Desktop\test.xls")
dim myFileProp(0) as New com.sun.star.beans.PropertyValue
myFileProp(0).name="hidden"
myFileProp(0).value=True
oDocument = StarDesktop.loadComponentFromURL(url, "_blank", 0, myFileProp() )


  oSheet = oDocument.sheets(0)
      oDstRange = osheet.getCellRangeByPosition(CRBP_L,CRBP_O,CRBP_R,CRBP_U) 'Spalte A , Zeile 1, Spalte N, Zeile 801
      oDstRange.setDataArray(oDataArray)

oDocument.store()
oDocument.close(true)


end sub

OpenOffice.info

Daten in eine andere Calc Datei exportieren

Daten in eine andere Calc Datei exportieren

Re: Daten in eine andere Calc Datei exportieren

Re: Daten in eine andere Calc Datei exportieren

Re: Daten in eine andere Calc Datei exportieren

Re: Daten in eine andere Calc Datei exportieren

Re: Daten in eine andere Calc Datei exportieren

Re: Daten in eine andere Calc Datei exportieren