stell mal das ganze Makro ein, sieht wüst aus
Möchte eigentlich auch Daten aus einer externen Datei übertagen, dazu öffne ich die Datei mittels des Öffnen dialogs, schaue dann ob die Daten Spalte 0,1 und 3 in der Stammdatei schon vorhanden sind, wenn ja dann möchte ich sie überschreiben und wenn nicht, in eine neue Zeile schreiben. Ganz zum Schluß möchte ich die Tabelle dann sortieren um die Daten einzugliedern.
wie gesagt mein Problem ist die Sache mit der odocu.currentcontroller.select(vonBereich) Anweisung
die wird im zweiten Durchlauf nicht mehr so gefüllt, wie ich es mir wünsche.
Code: Alles auswählen
Sub Datei_oeffnen_dialog
dim document as object
dim dispatcher as object
dim row as object
Dim odoc As Object
Dim odocu As Object
Dim ozielTab As Object
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
odoc = ThisComponent
ozielTab = odoc.Sheets.getByName("Versuchspersonen")
'Dialog "Datei öffnen"
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Open", "", 0, Array())
odocu = ThisComponent
oquellTab =odocu.sheets().getbyname("Versuchspersonen")
'vergleich ob Daten schon vorhanden sind
for zii = 2 to 100
oRange_fb_a = oquellTab.getCellByposition(0, zii).string
msgbox (orange_fb_a)
oRange_fb_b = oquellTab.getCellByposition(1,zii).string
oRange_fb_c = oquellTab.getCellByposition(3,zii).string
if oRange_fb_a ="" and oRange_fb_b ="" then
exit sub
end if
'bei mehr als 1000 Versuchspersonen in der Datenbank hier Erhöhen
for zi = 0 to 20
oRange_vp_a = ozielTab.getCellByposition(0, zi).string
' msgbox (orange_vp_a)
oRange_vp_b = ozielTab.getCellByposition(1, zi).string
oRange_vp_c = ozielTab.getCellByposition(3, zi).string
if oRange_fb_a = oRange_vp_a and oRange_fb_b = oRange_vp_b and oRange_fb_c = oRange_vp_c and oRange_fb_a <> "" then
' Abfrage ob Daten wirklich überschrieben werden sollen
wert = msgbox ("möchten Sie die alten Daten"+ " " + oRange_fb_a + " " + oRange_fb_b+ " " +" wirklich überschreiben?",4,48,"")
if wert = 6 then
'vorhandene Daten auf Tabellenblatt 1 bringen
Dim vonBereich As Object
vonBereich = oquellTab.GetCellrangeByPosition(0,zii,255,zii) ''' zu kopierender Bereich
dim oFrame As object
dim oDisp As object
oFrame = ThisComponent.CurrentController.Frame
oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
odocu.currentcontroller.select(vonBereich)
oDisp.executeDispatch(oFrame, ".uno:Copy", "", 0, Array())
args2(0).Value = "A"+(zi+1)
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2())
' dispatcher.executeDispatch(document, ".uno:InsertRows", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
msgbox ("über alte Personendatenzeile als neue Zeile eingefügt")
dispatcher.executeDispatch(document, ".uno:DeleteRows", "", 0, Array())
exit for
else
exit for
end if
else
'Tabelle durchsucht und kein vorhandenen Datensatz gefunden
'schreiben der Daten in Zeile 3
if zi=20 then
vonBereich2 = oquellTab.GetCellrangeByPosition(0,zii,255,zii) ''' zu kopierender Bereich
oFrame = ThisComponent.CurrentController.Frame
oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
odocu.currentcontroller.select(vonBereich2)
oDisp.executeDispatch(oFrame, ".uno:Copy", "", 0, Array())
args2(0).Value = "A3"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2())
dispatcher.executeDispatch(document, ".uno:InsertRows", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
msgbox ("neuer Datensatz eingefügt"+" "+ oRange_fb_a + " " + oRange_fb_b )
end if
end if
next zi
zi=0
next zii
sortieren
'Bereich von zeile 2 bis 1000 markiert und sortiert
odoc = ThisComponent
ozielTab = odoc.Sheets.getByName("Versuchspersonen")
Dim vonBereich1 As Object
vonBereich1=ozielTab.getCellRangeByPosition(0,2,255,1000)
oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
odoc.currentcontroller.select(vonBereich1)
dispatcher.executeDispatch(document, ".uno:SortAscending", "", 0, Array())
end sub
greetz
