bin seit einigen Wochen auf LibreOffice umgestiegen (versuchsweise) und komme folglich von MS Office. Ich wende mich an euch da weder die Suchmaschinen meines Vertrauens noch die Forensuche etwas dergleichen ausgegeben hat.
Bei Excel war/ist es relativ leicht an Beispiele ranzukommen und den Code entsprechned der eigenen Bedürfnisse anzupassen, leider musste ich bei OO und LO kapitulieren.
Muss leider etwas weiter ausholen evtl. zum besseren Verständnis.
Habe (hatte) mehrere Excel-Dateien für verschiedene Dinge aber alle mit demselben VBA-Code, nur der Inhalt der Tabellen ist verschieden.
Es sollen Dateien samt Endungen aus Ordner+Unterodner aufgelistet werden. In Spalte A der Dateiname und in Spalte B der Pfad. Zum einlesen der Dateien wurde ein Excel-AddIn verwendet:
Ist sehr komplex und die meisten Funktionen brauche ich nicht. Da es verschiedene Ordner gibt, gibt es auch mehrere Tabellenblätter.
Ich habe durch Zufall einen Code gefunden, der zwar nur "PDF's" auflistet aber ich hab's etwas modifiziert damit alles aufgelistet wird:
Code: Alles auswählen
sub PDF_Hyperlinks
dim liste()
Folderpath="C:\test1\" 'edit your path here
calc_delete_all
If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then GlobalScope.BasicLibraries.LoadLibrary("Tools")
Tabelle = Thiscomponent.getSheets().getbyIndex(0)
getdirs( liste(),z, Folderpath)
i=0
For il = 0 to ubound(liste())
Tabelle.getCellbyPosition(0,i).formulaLocal = "=HYPERLINK(" & chr(34) & ConvertFromURL(liste(il)) & chr(34) & ";" & chr(34) & ConvertFromURL(Filenameoutofpath(liste(il),"/")) & chr(34) &")"
i=i+1
next il
rem---Tabelle sortieren
sortier_Tabelle(Tabelle,i)
end sub
sub calc_delete_all
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:SelectAll", "", 0, Array())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:ClearContents", "", 0, Array())
end sub
function getdirs( liste(),z, Folder)
on error goto skip
sFolderUrl = ConvertToUrl( Folder )
oSimpleFileAccess = createUnoService( "com.sun.star.ucb.SimpleFileAccess" )
aFolders = oSimpleFileAccess.getFolderContents( sFolderUrl,true )
For i = LBound( aFolders ) To UBound( aFolders )
sFile = aFolders( i )
If oSimpleFileAccess.isFolder( sFile ) Then
getdirs( liste(),z, sFile)
Else
redim preserve liste(z)
liste(z)=sFile
z=z+1
end if
next i
skip:
getdirs=z+1
end function
sub sortier_Tabelle(oTable,rows)
Dim SortProps(2) As new com.sun.star.beans.PropertyValue
Dim SortFeld(0) As new com.sun.star.table.TableSortField
SortierBereich = oTable.getCellRangeByName("A1:A"+rows)
SortFeld(0).Field = 0
SortFeld(0).IsAscending = True
SortFeld(0).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC
SortProps(0).Name = "SortFields"
SortProps(0).Value = SortFeld()
SortProps(1).Name = "SortColumns"
SortProps(1).Value = False
SortProps(2).Name = "ContainsHeader"
SortProps(2).Value = False
SortierBereich.Sort(SortProps())
end sub
Die nächste Hürde ist, das ich für jedes Tabellenblatt diesen Code brauche, da pro Ordner ein Tabellenblatt genutzt wird. Auf jedes Tabellenblatt würde ich dann eine Schaltfläche platzieren über die dieser Code ausgeführt wird.
Sorry für den langen Text.
Ich hoffe ihr könnt mir unter die Arme greifen.
Vielen Dank im voraus.
Norbert