von Minok » Mi, 05.03.2008 15:25
hier es ist fertig danke für die hilfe!
Sub Main
Dim s,str,stt as String
Dim oCell,oCell1 as Object
oZellRange = ThisComponent.getCurrentSelection()
if oZellRange.supportsService("com.sun.star.sheet.SheetCell") then
oZellAdr = oZellRange.CellAddress
oDoc = ThisComponent
s= oDoc.Sheets(oZellAdr.Sheet).Columns(oZellAdr.Column).Name & oZellAdr.Row +1
t = "A" & oZellAdr.Row +1
oCell = ThisComponent.sheets(0).getCellRangeByName(s)
str=oCell.String
'MsgBox str
oCell1 = ThisComponent.sheets(0).getCellRangeByName(t)
stt=oCell1.String
'MsgBox stt
if stt = "" then
msgbox "Kundencode nicht vorhanden" , 16 , "Warnung"
end
'else
'msgbox "Else"
end if
'---------------------Zerlegen der RG-Nr--------------------------------
dim apfad()
surl = ThisComponent.url
apfad() = split(surl ,"/")'Pfad zum -
lp = ubound(apfad()) 'Verzeichniss in Array schreiben-
dim rg()
rg =split(str, "/")
if uBound(rg) > 0 then 'Abfrage ob Aray größer 0
'msgbox uBound(rg)
apfad(lp)=rg(0)
'----------------------------------------------------------------
'---------------------Datei Öffnen--------------------------------
bpfad = join(apfad(),"/")' neuen Pfad zusammensetzen
bpfad=bpfad & "/" & rg(1) & "-" & stt & ".ods"
If not fileExists(bpfad) then
msgbox "Datei nicht gefunden" & chr(13) & bpfad , 16 , "Warnung"
else
dim myFileProp() as Object
oDocument = StarDesktop.loadComponentFromURL(bpfad, "_blank", 0, myFileProp() )
end if
'-----------------------------------------------------
else
msgbox "Letzte RG-Nr. nicht gefunden: " & chr(13) & str , 16 , "Warnung"
end if
else 'Zellbereich
MsgBox "Es darf nur eine Zelle Markiert sein! " , 16 , "Warnung"
end if
End Sub
hier es ist fertig danke für die hilfe!
Sub Main
Dim s,str,stt as String
Dim oCell,oCell1 as Object
oZellRange = ThisComponent.getCurrentSelection()
if oZellRange.supportsService("com.sun.star.sheet.SheetCell") then
oZellAdr = oZellRange.CellAddress
oDoc = ThisComponent
s= oDoc.Sheets(oZellAdr.Sheet).Columns(oZellAdr.Column).Name & oZellAdr.Row +1
t = "A" & oZellAdr.Row +1
oCell = ThisComponent.sheets(0).getCellRangeByName(s)
str=oCell.String
'MsgBox str
oCell1 = ThisComponent.sheets(0).getCellRangeByName(t)
stt=oCell1.String
'MsgBox stt
if stt = "" then
msgbox "Kundencode nicht vorhanden" , 16 , "Warnung"
end
'else
'msgbox "Else"
end if
'---------------------Zerlegen der RG-Nr--------------------------------
dim apfad()
surl = ThisComponent.url
apfad() = split(surl ,"/")'Pfad zum -
lp = ubound(apfad()) 'Verzeichniss in Array schreiben-
dim rg()
rg =split(str, "/")
if uBound(rg) > 0 then 'Abfrage ob Aray größer 0
'msgbox uBound(rg)
apfad(lp)=rg(0)
'----------------------------------------------------------------
'---------------------Datei Öffnen--------------------------------
bpfad = join(apfad(),"/")' neuen Pfad zusammensetzen
bpfad=bpfad & "/" & rg(1) & "-" & stt & ".ods"
If not fileExists(bpfad) then
msgbox "Datei nicht gefunden" & chr(13) & bpfad , 16 , "Warnung"
else
dim myFileProp() as Object
oDocument = StarDesktop.loadComponentFromURL(bpfad, "_blank", 0, myFileProp() )
end if
'-----------------------------------------------------
else
msgbox "Letzte RG-Nr. nicht gefunden: " & chr(13) & str , 16 , "Warnung"
end if
else 'Zellbereich
MsgBox "Es darf nur eine Zelle Markiert sein! " , 16 , "Warnung"
end if
End Sub