Hallo mikele,
ich habe das Makro Deiner anregung nach noch einmal überarbeit.
a) Ich erzeuge eine Tabelle, gebe der einen Namen und lege sie im
definierten Directory ab. - Somit sehe ich in der Kopfzeile von Calc
auch den gewählten Namen -> Zusammenstellung-Jahreszahl <-.
Diese Datei ist dann meine oDoc.
Wenn ich da im Programmanfang etwas nicht richtig verstanden habe,
dann würde ich mich um eine Aufklärung freuen. - Eine Bestätigung
freut mich auch!
b) die DDE-Funktion erschließt sich mir noch nicht so richtig. Ich lese
zwar immer wieder von deren Vozügen, aber ich verstehe die Syntax
nicht so richtig.
Somit habe ich Deinen 2. Teil der Anregung komplett übernommen
und komme dann zu einem Fehler, den ich nicht verstehe und auch nicht
korrigieren kann - fehlende Kenntnis!!
Ich lege mal ein Bild der Fehlermeldung und den Programmcode bei.
Code: Alles auswählen
'Zusammenfassung Version 2
'
'Zusammenfassung von Quittungen
'Einen Zellbereich aus einem anderen ods-Dokument importieren.
'
'Von der nachfolgenden Adresse habe ich dieses Makro, das ich auf
'meine Bedürfnisse angepaßt habe.
'https://sites.google.com/site/starbasicmakros/makros-1/calc/verknuepfungen-zu-externen-datenquellen-einfuegen
'
'wesentliche Impulse kommen auch von dieser Seite:
'http://www.dannenhoefer.de/faqstarbasic/contents.htm
'
'Werner Gatzweiler im August 2016
'realisiert mit LibreOffice 5.1.4.2
'unter Lubuntu (Ubuntu)
'
'nachgebessert auf Anregung von
' mikele am 28. August 2016
'
Sub Zusammenfassung_V2
dim oDoc As object
Dim oSheet As Object
Dim oCellAddress As Object
dim n AS Integer
Dim sSource$,sFilterName$ ,sFilterOptions$ '$ steht für String.
Dim sFileURL$, sDir$, sURL$
Dim dummy()
'Die Bibliothek "Tools" laden. Wird für "DirectoryNameoutofPath()" benötigt.
GlobalScope.BasicLibraries.LoadLibrary("Tools")
'***************************
'welcher Jahrgang?
'
sAns = InputBox("welcher Jahrgang soll bearbeitet werden?" & Chr(13) & Chr(13) & "Beispiel: 2011"
if sAns <> "" and len(sAns)=4 then
sPath = ("home/gisela/Ferienwohnung/Quittungen/" & sAns)
else
exit sub
endif
erzeuge_Tabelle
sFileName = "/Zusammenfassung-" & sAns 'Generieren des Dateinamens
sSaveToURL = ConvertToURL(sPath & sFileName) 'Speicherort und Dateinamen zusammenfügen
dateiurl=converttourl(sSaveToURL)
odoc=thisComponent 'das ist die Zieldatei, die nachfolgend mit Pfad und Namen im Directory abgelegt wird
odoc.storeasurl(dateiurl,dummy()) 'Die Datei ist jetzt mit ihrem Namen = Zusammenfassung- & sAns im Directory abgelegt
oSheet = oDoc.Sheets.GetByName("Tabelle1") 'das Tabellenblatt der Zieldatei definieren
'Geschwindigkeit erhöhen.
oDoc.LockControllers
oDoc.AddActionLock
'************************************
' Kopfzeile der Tabelle beschreiben
'
oSheet.getCellbyPosition(0,0).string = sPath 'Der Hauptpfad
oSheet.getCellbyPosition(0,2).string = "Lfd.Nr."
oSheet.getCellbyPosition(1,2).string = "#Nr"
oSheet.getCellbyPosition(2,2).string = "Mieter"
oSheet.getCellbyPosition(3,2).string = "Anzahl Überna./Text"
oSheet.getCellbyPosition(4,2).string = "EURO"
oSheet.getCellbyPosition(5,2).string = "CENT"
oSheet.getCellbyPosition(6,2).string = "Gesamt"
'Die Kopfzeile wird formatiert
oSheet.getCellRangeByName("A1:G3").CharFontName="Comic Sans MS"
oSheet.getCellRangeByName("A1:G3").CharHeight="12"
oSheet.getCellRangeByName("A3:G3").CharWeight=com.sun.star.awt.FontWeight.BOLD
oSheet.getCellRangeByName("A3:G3").horijustify=2 'Kopfzellen zentrieren
NextFile = Dir(sPath & "/",0) 'hier wird die erste Datei im Verzeichnis aufgezeigt
Anzahl = 0 'ist der Zähler für die Anzahl der ausgewählten Dateien
'ab jetzt ist der Code neu
Dim aFormel()
i=5
While NextFile <> ""
if left(NextFile,4)="Quit" then 'hier wird das Auswahlkriterium für die Dateien gesetzt
Anzahl = Anzahl + 1
Redim Preserve aFormeln(i-1)
sURL = sDir & "/" & NextFile 'hier wird das Verzeichnis mit der Datei verbunden
'*****************************************************************
formelanfang="=DDE(""soffice"";""" & surl & """;"""
msgbox formelanfang
aFormel(i-1)=array(formelanfang & "Quittung.B5" & """)",formelanfang & "Quittung.A12" & """)",formelanfang & "Quittung.A14" & """)",formelanfang & "Quittung.F3" & """)",formelanfang & "Quittung.H3" & """)")
end if
NextFile = Dir
Wend
'Eintrag in die Zieltabelle
if anzahl>0 then
oBereich = oDoc.Sheets.GetByName("Tabelle1").getcellrangebyposition(1,4,5,3+anzahl)
oBereich.SetFormulaArray(aformeln)
'Optional: Die Verknüpfung zu dem Lik wieder entfernen.
'Der Inhalt bleibt bestehen, wird aber nicht mehr automatisch beim Neuladen aktualisiert.
aWerte=oBereich.GetDataArray
oBereich.SetDataArray(aWerte)
end if
End Sub
'***************************
'eine Tabelle erzeugen
'
Sub erzeuge_Tabelle
Dim Desktop as object
Dim Mappe as object
Dim Tabelle as object
Dim dummy()
Desktop = CreateUnoService ("com.sun.star.frame.Desktop")
Mappe = Desktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, dummy())
end sub

- Fehlermeldung.jpg (13.7 KiB) 5924 mal betrachtet
Mit Gruß
Werner