OpenOffice.info

Code: Alles auswählen

REM  *****  BASIC  *****
Option Explicit
Public document as object 

Sub Copy_Quelle
Dim var_File as Variant		' Datei Namen und Pfad
Dim var_Path as Variant
Dim o_Doc_Z As Object		' Ziel Dokument
Dim o_Doc_Q As Object		' Quell Document
Dim str_UrlSrc as String	' Für das öffnen des Dokuments
Dim var_Bereich_Q as Variant	' Array für den Quell Bereich 
Dim var_Bereich_Z as Variant	' Array für den Ziel Bereich
Dim o_Sheet_Z As Object			' Zieltabelle
Dim o_Sheet_Q As Object			' Quelltabelle	
Dim str_Ber as String			' Welcher Bereich
Dim myFileProp(0) as New com.sun.star.beans.PropertyValue	' ????
Dim dispatcher as object          ' ????


var_Path ="D:\xxx\"
var_File = var_Path & Dir("D:\xxx\*.xls", 0)
Do
   	' Zeile öffnen und Bereich festlegen
	rem ----------------------------------------------------------------------
	rem get access to the document
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
        o_Doc_Z = thisComponent			' Ziel Dokument zuweisen
	o_Sheet_Z = o_Doc_z.Sheets(0) 	'Zieltabelle zuweisen (0 ist die Erste)
	str_Ber ="A1:D108"

	' Quelldatei
	str_UrlSrc  = converttoURL(var_File) 'Pfad zum Dokument anpassen
	myFileProp(0).value = True 									'False > Im Vordergrund öffnen
	o_Doc_Q = StarDesktop.loadComponentFromURL(str_UrlSrc, "_blank", 0, myFileProp())
        o_Doc_Q = thisComponent										' Quell Document
	o_Sheet_Q = o_Doc_Q.Sheets(0)								'Quelltabelle zuweisen (0 ist die Erste)
	var_Bereich_Q =  o_Sheet_Q.getCellRangeByName(str_Ber).getDataArray() ' Quelle lesen
	var_Bereich_Z =o_Sheet_Z.getCellRangeByName(str_Ber)		' Zum Zielbereich gehen
	var_Bereich_Z.setDataArray(var_Bereich_Q) 					' Daten von Quelle in Ziel einfügen
	
	o_Doc_Q.close(True) 										' Quelldokument schliessen
       ' ####         	
       dispatcher.executeDispatch(document, ".uno:RunMacro", "", 0, Array()) 'gesamt.ods.Standard.moo1.Main

'	var_File = var_Path & Dir
' Loop Until var_File = ""
' kann nicht funktionieren da var_Path immer einen Wert hat
'Änderung:
	var_File = Dir 		' nächster Dateiname
	var_Pruef = var_File ' für Prüfung ob noch ein Dateiname vorhanden ist
	var_File = var_Path & var_File ' Path und Dateiname zusammen
Loop Until var_Pruef = ""


End Sub

Code: Alles auswählen

call makroname

Code: Alles auswählen

...
'	var_File = var_Path & Dir
' Loop Until var_File = ""
' kann nicht funktionieren da var_Path immer einen Wert hat
'Änderung:
	var_File = Dir 		' nächster Dateiname
	var_Pruef = var_File ' für Prüfung ob noch ein Dateiname vorhanden ist
	var_File = var_Path & var_File ' Path und Dateiname zusammen
Loop Until var_Pruef = ""

End Sub

Code: Alles auswählen

Dim obj_Macro as Object
	obj_Macro = "Main"  ' Macro ist "gesamt.ods.Standard.moo1.Main" 
	call obj_Macro

Code: Alles auswählen

call Main

Code: Alles auswählen

Sub Start
Aufgerufene_Sub ' springe zu "Aufgerufene_Sub" und führe diese aus
msgbox "Jetzt bin ich wieder in der > Sub Start <"
End Sub

Sub Aufgerufene_Sub
msgbox "Jetzt bin ich der > Aufgerufene_Sub <"
End Sub

Code: Alles auswählen

Sub Start
BasicLibraries.LoadLibrary("Library1")'Bibliothek "Library1" initialisieren
Aufgerufene_Sub ' springe zu "Aufgerufene_Sub" und führe diese aus
msgbox "Jetzt bin ich wieder in der > Sub Start < "
End Sub

Code: Alles auswählen

Sub Aufgerufene_Sub
msgbox "Jetzt bin ich der > Aufgerufene_Sub < "
End Sub

Code: Alles auswählen

Sub Copy_Quelle 
..........' Copy_Quelle wird abgearbeitet

BasicLibraries.LoadLibrary("Standard")'Bibliothek Standard laden
Main 'Aufruf der Sub Main aus der Bibliothek Standard und abarbeiten

........'weiter mit dem Rest der Sub Copy_Quelle (wenn vorhanden)

End Sub

Code: Alles auswählen

Option Explicit
Public document as object 

Sub Copy_Quelle
Dim var_File as Variant		' Datei Namen und Pfad
Dim var_Path as Variant
Dim o_Doc_Z As Object		' Ziel Dokument
Dim o_Doc_Q As Object		' Quell Document
Dim str_UrlSrc as String	' Für das öffnen des Dokuments
Dim var_Bereich_Q as Variant	' Array für den Quell Bereich 
Dim var_Bereich_Z as Variant	' Array für den Ziel Bereich
Dim o_Sheet_Z1 As Object			' Zieltabelle
Dim o_Sheet_Q1 As Object			' Quelltabelle	
Dim str_Ber as String			' Welcher Bereich
dim myFileProp(0) as New com.sun.star.beans.PropertyValue	' ????
dim dispatcher as object
dim var_Pruef as Variant	'Prüfung auf Ende

var_Path ="D:xxx\"
var_File = var_Path & Dir("D:\xxx\*.xls", 0)
Do
   	' Zeile öffnen und Bereich festlegen
	rem ----------------------------------------------------------------------
    document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    o_Doc_Z1 = thisComponent			' Ziel Dokument zuweisen
    o_Sheet_Z1 = o_Doc_Z1.Sheets(0) 	'Zieltabelle zuweisen (0 ist die Erste)
	str_Ber ="A1:D108"
	
	' Quelldatei
	str_UrlSrc  = converttoURL(var_File) 'Pfad zum Dokument anpassen
	myFileProp(0).value = True 									'False > Im Vordergrund öffnen
	o_Doc_Q = StarDesktop.loadComponentFromURL(str_UrlSrc, "_blank", 0, myFileProp())
	o_Doc_Q = thisComponent										' Quell Document
	If Mid(o_Doc_Q.Title,1 ,3) ="ges" then goto Sprung ' Gesamtdateien überspringen
	o_Sheet_Q1 = o_Doc_Q.Sheets(0)								'Quelltabelle zuweisen (0 ist die Erste)
	var_Bereich_Q =  o_Sheet_Q1.getCellRangeByName(str_Ber).getDataArray() ' Quelle lesen
	var_Bereich_Z =o_Sheet_Z1.getCellRangeByName(str_Ber)		' Zum Zielbereich gehen
	var_Bereich_Z.setDataArray(var_Bereich_Q) 					' Daten von Qelle in Ziel einfügen
	o_Doc_Q.close(True) 										' Quelldokument schliessen

	o_Doc_Z1.CurrentController.Frame.getContainerWindow().setFocus  ' Focus auf die Zieldatei

	' Macro für die Weiterverarbeitung im der selben Library
	sub_copy
	
Sprung:
	var_File = Dir 		' nächster Dateiname
	var_Pruef = var_File ' für Prüfung ob noch ein Dateiname vorhanden ist
	var_File = var_Path & var_File ' Path und Dateiname zusammen
Loop Until var_Pruef = ""


End Sub