Miro máš pravdu trocha som sa od pôvodného zadania odklonil ale takto sa mi to zdá praktickejšie.
Tak a tu je už upravený kód ktorý rozlišuje či sa na strane niečo nachádza alebo nie plus sú tam aj kozmetické úpravy.
Sub Zlucit_Subory
'**************************Načťítanie súborov ktoré sa majú zlúčiť************************
Dim oFileDialog as Object
Dim iAccept as Integer
Dim sPath() as String
Dim InitPath as String
Dim RefControlName as String
Dim oUcb as Object
'Dim ListAny(0)
Dim filterNames(1) As String
Dim MultiSelection As Boolean
filterNames(0) = "*.ods; *.xls"
filterNames(1) = "*.*"
MultiSelection = True
'knižnica ktorá medzi iným umožnuje načítať pracovný adresár
GlobalScope.BasicLibraries.LoadLibrary("Tools")
'Note: The following services must be called in the following order ' otherwise the FileDialog Service is not removed.
oFileDialog =CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") 'ListAny(0) = _
' com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
'oFileDialog.initialize(ListAny())
'umožní alebo zakáže viacnásobné označovanie súborov
oFileDialog.MultiSelectionMode=MultiSelection
'pridáva filter ktoré súbory sa majú zobraziť podla FilterNames
AddFiltersToDialog(FilterNames(), oFileDialog)
'Názov okna
oFileDialog.Title="Vyberte súbory na zlúčenie"
'Set your initial path here!
'InitPath = ConvertToUrl(oRefModel.Text)
Do
If InitPath = "" Then
InitPath = GetPathSettings("Work")
End If
If oUcb.Exists(InitPath) Then
oFileDialog.SetDisplayDirectory(InitPath)
End If
iAccept = oFileDialog.Execute()
If iAccept = 1 Then
sPath = oFileDialog.Files()
'If oUcb.Exists(sPath) Then
' oRefModel.Text = ConvertFromUrl(sPath)
'End If
End If
'Ak bol vybraný jeden súbor tak nieje čo zlučovať
coto=UBound(sPath)
If UBound(sPath)=0 Then
sVar% =MsgBox("Chceš vybrať znova?",148,"Bol zvolený len jeden súbor")
if sVar<>6 Then Exit Sub
'bolo stlačené tlačítko zrušiť
elseif UBound(sPath)=-1 Then
Exit Sub
end if
Loop While UBound(sPath)<=0
oFileDialog.Dispose()
'*********************************Otváranie dokumentov*********************
'Long - &
'String - $
'Integer - %
Dim ZpusobOtevreni1(1) As new com.sun.star.beans.PropertyValue
Dim ZpusobOtevreni2(0) As new com.sun.star.beans.PropertyValue
Dim Dokument, NovyDokument As Object
Dim Adresa, List As String
'otvorenie nového súboru
ZpusobOtevreni2(0).Name = "DocumentTitle"
ZpusobOtevreni2(0).Value = "Zlucene_dokumenty"
NovyDokument= StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, ZpusobOtevreni2())
clNovy&=0
for SuborIndex&=1 to UBound(sPath)
Adresa=sPath(0)&"/"&sPath(SuborIndex)
If oUcb.Exists(Adresa) Then
ZpusobOtevreni1(0).Name = "ReadOnly"
ZpusobOtevreni1(0).Value = True
ZpusobOtevreni1(1).Name = "Hidden"
ZpusobOtevreni1(1).Value = True
Dokument=StarDesktop.loadComponentFromURL(Adresa,"_blank", 0, ZpusobOtevreni1())
for clDokument&=0 to Dokument.getSheets.getCount-1
'list
List=Dokument.Sheets.getByIndex(clDokument).Name
'vyber list ktorý chceš kopírovať
selectSheetByName(Dokument, List)
'skontroluje či na liste niečo je
if PlnyList(Dokument, List) then
'zistí či nový súbor má volný list ak nie tak ho vytvorí
If NovyDokument.getSheets.getCount-1<clNovy Then NovyDokument.getSheets().insertNewByName("Nový list",clNovy)
'označí všetko
dispatchURL(Dokument,".uno:SelectAll")
'kopíruje
dispatchURL(Dokument,".uno:Copy")
'vyber list kam chceš kopírovať
selectSheetByName(NovyDokument, NovyDokument.Sheets.getByIndex(clNovy).Name)
'vloží
dispatchURL(NovyDokument,".uno:Paste")
'premenovanie listu podla názvu súboru a názvu listu
NovyDokument.Sheets.getByIndex(clNovy).setName(MenoListu(sPath(SuborIndex),List))
clNovy=clNovy+1
end if
next clDokument
Dokument.Dispose()
End if
Next SuborIndex
End Sub
sub selectSheetByName(document, sheetName)
document.getCurrentController.select(document.getSheets().getByName(sheetName))
end sub
Sub dispatchURL(document, aURL)
Dim noProps()
Dim URL as new com.sun.star.util.URL
frame = document.getCurrentController().getFrame()
URL.Complete = aURL
transf = createUnoService("com.sun.star.util.URLTransformer")
transf.parseStrict(URL)
disp = frame.queryDispatch(URL, "", com.sun.star.frame.FrameSearchFlag.SELF OR com.sun.star.frame.FrameSearchFlag.CHILDREN)
disp.dispatch(URL, noProps())
End Sub
Function PlnyList(document, sheetName) As Boolean
'zistí či aktývny list je prázdny
'Dokument = ThisComponent
'Stav = Dokument.getCurrentController
List = document.getSheets().getByName(sheetName)
Bunka = List.getCellbyPosition(0, 0)
Kurzor = List.createCursorByRange(Bunka)
'prejde na poslednú bunku využitej oblasti True-Vytvorí oblasť False-prejde len na bunku
Kurzor.gotoEndOfUsedArea(False)
Adresa = Kurzor.RangeAddress
if Adresa.EndRow>0 or Adresa.EndColumn>0 or Bunka.Formula<>"" then
PlnyList=True
else
PlnyList=False
end if
end Function
Function MenoListu (Subor, List as String) as String
'vytvorí sa názov nového listu podla názvu súboru a názvu listu
MenoListu=Subor & " " & List
'Niektoré písmenká to zopsuje takoto sa to napraví
Dim A As Variant, B As Variant
A = Array(" ","ă","ą","ć","č","ď","đ","ě","ę","ĺ","ľ","ł","ń","ň","ő","ŕ","ř","ś","ş","š","ť","ţ","ů","ű","ź","ž","ż","Ă","Ą","Ć","Č","Ď","Đ","Ě","Ę","Ĺ","Ľ","Ł","Ń","Ň","Ő","Ŕ","Ř","Ś","Ş","Š","Ť","Ţ","Ů","Ű","Ź")
B = Array("%20","%C4%83","%C4%85","%C4%87","%C4%8D","%C4%8F","%C4%91","%C4%9B","%C4%99","%C4%BA","%C4%BE","%C5%82","%C5%84","%C5%88","%C5%91","%C5%95","%C5%99","%C5%9B","%C5%9F","%C5%A1","%C5%A5","%C5%A3","%C5%AF","%C5%B1","%C5%BA","%C5%BE","%C5%BC","%C4%82","%C4%84","%C4%86","%C4%8C","%C4%8E","%C4%90","%C4%9A","%C4%98","%C4%B9","%C4%BD","%C5%81","%C5%83","%C5%87","%C5%90","%C5%94","%C5%98","%C5%9A","%C5%9E","%C5%A0","%C5%A4","%C5%A2","%C5%AE","%C5%B0","%C5%B9")
For i%=0 To UBound(A())
MenoListu=Replace(MenoListu, B(i), A(i))
next i
end function
