OpenOffice.info

deutsches Forum rund um Apache OpenOffice und LibreOffice
http://www.oooforum.de/

[SOLVED] Datenbereich von einem Dokument in ande. übertragen

http://www.oooforum.de/viewtopic.php?t=43438

Seite 1 von 1

[SOLVED] Datenbereich von einem Dokument in ande. übertragen

Verfasst: Mi, 27.10.2010 10:50
von Koala
Hallo

Folgendes soll als automatische Abarbeitung in einem Macro umgesetzt werden:
Gegeben ist eine Exceltabelle mit Daten (A1:H1 als Beschriftung, alles darunter gefüllt mit Daten; ca. 4000 Zeilen),
und eine OOCalc Vorlagendatei in der die erste Zeile von A1:H1 mit einer Beschriftung und bestimmten Formatierung fest belegt ist (in dieser Datei soll dann auch das Macro hinterlegt werden).
  • Aus der Exceltabelle sollen alle Daten ab A2 in die Calc-Datei übernommen/importiert und ab Position A2 eingefügt werden.
  • Dann sollen die Formatierungen aus der Überschrift auf die jeweiligen Zeilen darunter übernommen werden (oder alternativ muss eine Formatierung per Macro ausgeführt werden).
  • Als letzter Schritt muss diese Vorlagendatei mit dem gleichen Namen wie die Exceldatei als *.ods gespeichert werden.
Ich habe mich nun schon einige Tage mit dem Thema befasst, aber den richtigen Anfang noch nicht finden können.
Also, meine Frage für den Anfang lautet:

Wie kann man Daten aus einer Exceltabelle in Calc per Macro importieren und an eine vorgegebene Position einfügen?


Mir ist dabei so ziemlich jeder Weg recht, so lange der Benutzer am Ende nichts weiter machen muss, als die Vorlagendatei zu öffnen und das Macro zu starten (wobei, wenn ich das so recht überlege, könnte das Macro später auch direkt beim öffnen der Datei ausgeführt werden ... aber so weit bin ich ja noch nicht mal ansatzweise).
Einen Auswahldialog zum Import der richtigen Exceldatei benötige ich später auch noch, aber das ist ersteinmal zweitrangig.



OOo 3.2.0 WinXP

Re: Excel Daten in bestimmten Calc Bereich importieren

Verfasst: Mi, 03.11.2010 14:11
von Koala
Ein erster Erfolg ist dank diesen Beitrages nun schon zu verzeichnen.
Ich hatte nicht erwartet, dass es mit OOo doch so einfach ist, mit einer Exceldatei zu arbeiten :)

Code: Alles auswählen

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

    sPath = "Verzeichnis_zu\Art_Merch_tmp" & 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$
	    'folgend Quelldokument im Hintergrund öffnen
	    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())
	    
	    'folgend Wert aus Quelldokument lesen
	    oSheet = oDocument.sheets(0) 'erstes Tabellenblatt des Quelldokumentes
	    iVal = oSheet.getCellRangebyName("A3").String 'Integerwert auslesen
	    iResult = iVal 'Berechnung
	    
	    'folgend berechneten Wert in das Zieldokument schreiben
	    thisDoc = thisComponent 'Zieldokument ansprechen
	    oSheet = thisDoc.sheets(0) 'erstes Tabellenblatt der Zieldatei
	    ocell1 = osheet.getCellByPosition(0,r)'Spalte A , Zeile r
'	    ocell1.value = iResult 'berechneten Wert eintragen
	    ocell1.Formula = iResult 'berechneten Wert eintragen
	    
	    r = r + 1 'Zeile hochzählen
	    redim myFileProp
	    oDocument.close(true) 'Quelldokument schliessen
    Loop Until sFileName = ""
    msgbox "Der Vorgang ist abgeschlossen" ,64 , "Dateien auslesen"
End Sub
Der Test funktioniert nun schon so weit, dass der Wert von A3 aus xls in ods eingefügt wird.
Jetzt habe ich aber keinen festen Bereich nach unten und benötige daher eine Selection des Bereiches, in dem sich Daten befinden.
Habe dazu mal den Macrorecorder bemüht, der mir das ausgegeben hat:

Code: Alles auswählen

sub Main
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 args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = true

dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, args1())

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

dispatcher.executeDispatch(document, ".uno:GoRightToEndOfData", "", 0, args2())
end sub
Ist das der beste Weg für eine Bereichsselektion, oder gehts auch anders?
Wie kann ich den markierten Bereich dann kopieren und in die ods-Datei einfügen?

Re: Excel Daten in bestimmten Calc Bereich importieren

Verfasst: Fr, 12.11.2010 12:00
von Koala
Inzwischen habe ich ein funktionierendes Macro, dass mir einen bestimmten Cellbereich (Range) von einem Dokument in ein anderes kopiert:

Code: Alles auswählen

Sub Main
    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 A
    CRBP_O = 1 ' CellRangeByPosition Oben		Zeile 2
    CRBP_R = 13 ' CellRangeByPosition Rechts	Spalte N
    CRBP_U = 801 ' CellRangeByPosition Unten	Zeile 801

    sPath = "Verzeichnis_zu\Art_Merch_tmp" & 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$
      'folgend Quelldokument im Hintergrund öffnen
      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())

      'Werte aus Quelldokument lesen
      oSheet = oDocument.sheets(0) 'erstes Tabellenblatt des Quelldokumentes
      oSrcRange = osheet.getCellRangeByPosition(CRBP_L,CRBP_O,CRBP_R,CRBP_U) 'Spalte A , Zeile 2, Spalte N, Zeile 801
      oDataArray = oSrcRange.getDataArray

      'Werte in das Zieldokument schreiben
      thisDoc = thisComponent 'Zieldokument ansprechen
      oSheet = thisDoc.sheets(0) 'erstes Tabellenblatt der Zieldatei
      oDstRange = osheet.getCellRangeByPosition(CRBP_L,CRBP_O,CRBP_R,CRBP_U) 'Spalte A , Zeile 2, Spalte N, Zeile 801
      oDstRange.setDataArray(oDataArray)
    
      redim myFileProp
      oDocument.close(true) 'Quelldokument schliessen
'    Loop Until sFileName = ""
    msgbox "Der Vorgang ist abgeschlossen" ,64 , "Dateien auslesen"
End Sub

Was mir jetzt noch fehlt ist die Möglichkeit, die Größe des auszuwählenden Zellbereiches auf die eingegebenen Daten zu begrenzen.
Also die Werte für CRBP_R und CRBP_U müssten automatisch ermittelt werden können, da die genaue Zeilenanzahl im Quelldokument immer unterschiedlich ist.

Wie macht man das am besten?

Re: Datenbereich von einem Dokument in ein anderes übertragen

Verfasst: Fr, 12.11.2010 19:22
von turtle47
Hi Sven,

Code: Alles auswählen

	oCellCursor = oSheet.createCursor()
	oCellCursor.GotoEndOfUsedArea(True)	
	CRBP_R = oCellCursor.getRangeAddress.EndColumn
	CRBP_U = oCellCursor.getRangeAddress.EndRow
holt die gesuchten Werte.

Viel Erfolg.

Jürgen

Re: Datenbereich von einem Dokument in ein anderes übertragen

Verfasst: Fr, 12.11.2010 19:24
von keksi1970
Hi,

solange in deinem Bereich die letzte benutzte Zeile/Spalte deine zu kopierenden Daten enthält, findest du die Antwort hier :

http://www.dannenhoefer.de/faqstarbasic ... l#Zweig214


ich kopiere das Makro nicht, wäre ja unfair wegen Urheberrecht und so ;)

Dank geht an Ykcim aus dem Forum hier :)

LG
Andreas

Ach Jürgen, warst wieder schneller ;)

Re: Datenbereich von einem Dokument in ein anderes übertragen

Verfasst: Mo, 15.11.2010 09:48
von Koala
Hier nun mein erstes, für mich zufriedenstellendes und vor allem funktionierendes Ergebnis.

Kurze zusammenfassende Erklärung dazu (falls es jemand anderes mal brauchen sollte).
Eingebettet ist das Macro in einer Vorlagendatei (.odt).
Eine (Calc- oder Excel-) Datei mit beliebigen Namen wird aus einem Verzeichnis geöffnet (es sollte sich immer nur eine Datei in diesem Verzeichnis befinden). In dieser Quelldatei wird der gesamte mit Daten gefüllte Bereich markiert und kopiert. Ausgenommen davon ist die erste Zeile mit den Spaltenüberschriften.
Im Zieldokument wird der kopierte Bereich ab der zweiten Zeile eingefügt. Der Tabellenname des Quelldokumentes wird ebenfalls mit übernommen.
Gespeichert wird das Ergebnis als .ods mit dem gleichen Namen, wie die Quelldatei, nur eben jetzt als OOo-Datei.
In der Vorlagendatei sind alle Spalten bereits fertig vorformatiert (Schriftgröße, Textausrichtung(zentriert oder rechts)). Beim Einfügen der Daten aus dem Quelldokument bleiben diese Formatierungen erhalten und ersparen ein nachträgliches formatieren per Macro.
Das einzige was per Macro angepasst werden muss, ist die optimale Spaltenbreite.

Code: Alles auswählen

Sub Main
' Das Verzeichnis Verzeichnis_zu\Art_Merch_tmp muss existieren!
' In diesem Verzeichnis darf sich nur eine Datei befinden.
 
	rem define variables
    Dim sPath, dPath, fullPath, iVal, iResult, srcName, srcFileTitle As String
'    Dim r  as Integer
    Dim oDocument, thisDoc, oSheet, oCell1, oVal, oSrcRange, oDstRange, oCon as Object
    Dim arg()

    ' Startposition fuer CellRangeByPosition festlegen
    CRBP_L = 0 ' CellRangeByPosition Links		Spalte A
    CRBP_O = 1 ' CellRangeByPosition Oben		Zeile 2

    setCursorTo = "B2" ' setzt den Cursor im Zieldokument auf diese Position
    
    rem Hier gehts los
    sPath = "Verzeichnis_zu\Art_Merch_tmp" & getpathseparator 'Ort der die Dateien enthält >> Pfad anpassen!
    dPath = "Verzeichnis_zum_Ziel" ' Zielpfad
'    r = 1 'Startwert Zeile setzen
    sFileName = Dir$(sPath & getPathSeparator() & "*", 0)
'    Do
      fullPath = converttourl(sPath & sFileName)
      sFileName = Dir$

      ' ====== Q U E L L E =====
      ' Quelldokument im Hintergrund öffnen
      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())
      
      ' Lese Dateinamen aus (ohne Extension!)
      args = oDocument.Args
      For i = LBound(args()) To UBound(args())
        If args(i).Name = "Title" Then
          srcFileTitle = args(i).Value
          Exit For
        End If
      Next i
      
      ' Werte aus Quelldokument lesen
      oSheet = oDocument.sheets(0) 'erstes Tabellenblatt des Quelldokumentes

      oCellCursor = oSheet.createCursor()
      oCellCursor.GotoEndOfUsedArea(True)   
      CRBP_R = oCellCursor.getRangeAddress.EndColumn
      CRBP_U = oCellCursor.getRangeAddress.EndRow

      ' hole Zelleninhalt aus Quelldokument
      oSrcRange = oSheet.getCellRangeByPosition(CRBP_L,CRBP_O, CRBP_R, CRBP_U) ' markiere zu kopierenden Bereich
      oDataArray = oSrcRange.getDataArray ' "kopiere" Daten in Variable
      srcName = oSheet.getName() ' hole Tabellenname des Quelldokuments

      ' ====== Z I E L =====
      ' Schreibe Werte in das Zieldokument
      thisDoc = thisComponent ' Zieldokument ansprechen
      oSheet = thisDoc.sheets(0) ' erstes Tabellenblatt der Zieldatei
      oDstRange = oSheet.getCellRangeByPosition(CRBP_L,CRBP_O,  CRBP_R, CRBP_U) ' markiere Bereich, in den eingefügt werden soll
      oDstRange.setDataArray(oDataArray) ' füge kopierte Daten ein
      
      ' Setze Tabellennamen (Name stammt aus dem Quelldokument)
      oSheet.SetName(srcName)
      
      ' Setze für alle Spalten die optimale Breite
      ' Anm: dies funktioniert nicht bei alle Spalten optimal, den Grund habe ich noch nicht herausgefunden (15.11.2010)
      For i = 0 to CRBP_R ' CRBP_R = oCellCursor.getRangeAddress.EndColumn
        oSheet.columns(i).OptimalWidth = True
      Next
      
      ' Optionale Einstellungen
      ' Setze Cursor an Position X (X = setCursorTo)
      oCon = thisDoc.getCurrentController()
      oCell1 = oSheet.getCellRangeByName(setCursorTo)
      oCon.select(oCell1)
      
      ' Speichern
      sDateiName = srcFileTitle & ".ods" ' Verwende den Namen der Quelldatei und ergänze ihn um ".ods"
      sURL = "private:factory/scalc"
      sURL = ConvertToURL(dPath & "\" & sDateiName) ' erzeuge zu speichernden Dateipfad (noch nicht optimal; Backslash dürfte nicht Systemunabhängig sein)
      thisDoc.storeAsURL(sURL, arg()) ' speichern
      
      
'      redim myFileProp
      oDocument.close(true) 'Quelldokument schliessen
'    Loop Until sFileName = ""
    msgbox "Der Vorgang ist abgeschlossen" ,64 , "Dateien auslesen"

End Sub

Beim Speichern der Datei wird auch das Macro mit gespeichert!
Nun muss ich nur noch herausfinden, wie man das wieder entfernen kann oder beim speichern gleich ganz weglassen kann. Denn das wird in der Zieldatei nicht benötigt.

Re: Datenbereich von einem Dokument in ein anderes übertragen

Verfasst: Di, 16.11.2010 12:38
von Koala
Das mit dem Entfernen des Macros habe ich nun auch hinbekommen.
Zusätzlich soll nun ein FreezeAtPosition (Fenster/fixieren) an Position "B2" ausgeführt werden. Dies funktioniert leider noch nicht richtig. Es wird immer nur die komplette Spalte B fixiert. Ob hier ein Bug vorliegt?

Weiterhin werden die Änderungen an dem neuen Dokument nur übernommen, wenn es nicht als "Hidden" geöffnet wird. Versteh ich zwar auch noch nicht, wieso das so ist.
Am Ende von allem schließt sich die Vorlagendatei selbstständig.

Code: Alles auswählen

Public sURL As String

Sub Main
' Das Verzeichnis Verzeichnis_zu\Art_Merch_tmp muss existieren!
' In diesem Verzeichnis darf sich nur eine Datei befinden.
    rem define variables
    Dim sPath, dPath, fullPath, iVal, iResult, srcName, srcFileTitle As String
'    Dim r  as Integer
    Dim oDocument, thisDoc, oSheet, oCell1, oVal, oSrcRange, oDstRange, oCon as Object
    Dim arg()

    ' Startposition fuer CellRangeByPosition festlegen
    CRBP_L = 0 ' CellRangeByPosition Links		Spalte A
    CRBP_O = 1 ' CellRangeByPosition Oben		Zeile 2

    rem Hier gehts los
    sPath = "Verzeichnis_zu\Art_Merch_tmp" & getpathseparator 'Ort der die Dateien enthält >> Pfad anpassen!
    dPath = "Verzeichnis_zum_Ziel" ' Zielpfad
'    r = 1 'Startwert Zeile setzen
    sFileName = Dir$(sPath & getPathSeparator() & "*", 0)
'    Do
      fullPath = converttourl(sPath & sFileName)
      sFileName = Dir$

      ' ====== Q U E L L E =====
      ' Quelldokument im Hintergrund öffnen
      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())
      
      ' Lese Dateinamen aus (ohne Extension!)
      args = oDocument.Args
      For i = LBound(args()) To UBound(args())
        If args(i).Name = "Title" Then
          srcFileTitle = args(i).Value
          Exit For
        End If
      Next i
      
      ' Werte aus Quelldokument lesen
      oSheet = oDocument.sheets(0) 'erstes Tabellenblatt des Quelldokumentes

      oCellCursor = oSheet.createCursor()
      oCellCursor.GotoEndOfUsedArea(True)   
      CRBP_R = oCellCursor.getRangeAddress.EndColumn
      CRBP_U = oCellCursor.getRangeAddress.EndRow

      ' hole Zelleninhalt aus Quelldokument
      oSrcRange = oSheet.getCellRangeByPosition(CRBP_L,CRBP_O, CRBP_R, CRBP_U) ' markiere zu kopierenden Bereich
      oDataArray = oSrcRange.getDataArray ' "kopiere" Daten in Variable
      srcName = oSheet.getName() ' hole Tabellenname des Quelldokuments

      ' ====== Z I E L =====
      ' Schreibe Werte in das Zieldokument
      thisDoc = thisComponent ' Zieldokument ansprechen
      oSheet = thisDoc.sheets(0) ' erstes Tabellenblatt der Zieldatei
      oDstRange = oSheet.getCellRangeByPosition(CRBP_L,CRBP_O,  CRBP_R, CRBP_U) ' markiere Bereich, in den eingefügt werden soll
      oDstRange.setDataArray(oDataArray) ' füge kopierte Daten ein
      
      ' Setze Tabellennamen (Name stammt aus dem Quelldokument)
      oSheet.SetName(srcName)
      
      ' Setze für alle Spalten die optimale Breite
      ' Anm: dies funktioniert nicht bei alle Spalten optimal, den Grund habe ich noch nicht herausgefunden (15.11.2010)
      For i = 0 to CRBP_R ' CRBP_R = oCellCursor.getRangeAddress.EndColumn
        oSheet.columns(i).OptimalWidth = True
      Next
      

      ' Speichern
      sDateiName = srcFileTitle & ".ods" ' Verwende den Namen der Quelldatei und ergänze ihn um ".ods"
      sURL = "private:factory/scalc"
      sURL = ConvertToURL(dPath & "\" & sDateiName) ' erzeuge zu speichernden Dateipfad (noch nicht optimal; Backslash dürfte nicht Systemunabhängig sein)
'      thisDoc.storeAsURL(sURL, arg()) ' speichern
      thisDoc.storeToURL(sURL, arg()) ' speichern
      
'      redim myFileProp
      oDocument.close(true) ' Quelldokument schliessen

      someThings ' erledige einige Dinge in der neu erstellten Datei
      thisDoc.close(true) ' schliessen der Vorlagedatei

'    Loop Until sFileName = ""
    msgbox "Der Vorgang ist abgeschlossen" ,64 , "Dateien auslesen"

End Sub

Sub someThings

  setCursorTo = "B2" ' setzt den Cursor im Zieldokument auf diese Position

  ' neues Zieldokument im Hintergrund öffnen
  dim myFileProp(0) as New com.sun.star.beans.PropertyValue
'  myFileProp(0).name = "Hidden"
'  myFileProp(0).value = true
  oDocument = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, myFileProp())
  
  RemoveMacro(oDocument)
  windowFreeze(oDocument)
  setzeCursor(oDocument, setCursorTo)
  
  Dim arg()
  oDocument.storeAsURL(sURL, arg()) ' speichern
  oDocument.close(true) ' Zieldokument schliessen
  
End Sub

' entferne alle Macros
Sub RemoveMacro(oDocument As Object)
  Dim oBLs as Object
  oBLs = oDocument.BasicLibraries
  if oBLs.hasByName("Standard")  then
    oBLs.removeLibrary( "Standard" )
  End If
End Sub

' setze Fixierung (Fenster/fixieren)
Sub windowFreeze(oDocument As Object)
  oCon = oDocument.getCurrentController()
  oCon.FreezeAtPosition(1,1)
End Sub

' Setze Cursor an Position X (X = setCursorTo)
Sub setzeCursor(oDocument As Object, setCursorTo As String)
  oSheet = oDocument.sheets(0) ' erstes Tabellenblatt
  oCon = oDocument.getCurrentController()
  oCell1 = oSheet.getCellRangeByName(setCursorTo)
  oCon.select(oCell1)
End Sub
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de