Hallo,
weil ich Lust dazu hatte, und etwas ähnliches schon gemacht habe. Anbei eine Datei, die genau das kann. In der Menüleiste findest du ein zusätzliches Symbol:
- TB.PNG (15.48 KiB) 4404 mal betrachtet
Einfach anklicken, Speicherordner wählen, und alle Blätter werden einzeln als PDF mit dem Namen des jeweiligen Tabellenblattes in den Speicherordner geschrieben.
Die Datei enthält Basic-Makros:
Code: Alles auswählen
Sub alle_Tabellen_einzeln_exportieren
nCounterExported = 0
if Thiscomponent.isModified then ThisComponent.store
ALL_PrintAreas = F_Get_PrintAreas
sFolderUrl = F_getfolderUrl
if sFolderUrl = false then exit sub
S_Delete_PrintAreas
nCounterExported = 0
for j = 0 to uBound(ALL_PrintAreas)
S_Store_to_PDF(j,ALL_PrintAreas(j),sFolderUrl)
nCounterExported = nCounterExported + 1
next j
msgbox (""+nCounterExported+" PDF Dateien in den Ordner "+CHR(13)+sFolderUrl+CHR(13)+"exportiert",64,"Erfolgreich")
F_Set_PrintAreas(ALL_PrintAreas)
thisComponent.Modified = false
end sub
function F_getfolderUrl
if not bLastDirectory then
oPS = createUnoService("com.sun.star.util.PathSettings")
sUSER_Work = oPS.Work
endif
MyDialog = createunoservice("com.sun.star.ui.dialogs.FolderPicker")
MyDialog.Title = "PDF - Ordner wählen"
myDialog.displaydirectory = sUSER_Work
if mydialog.execute = 0 then
F_getfolderUrl = false
else
sURL = mydialog.directory
F_getfolderUrl = ConvertfromUrl(sURL)
bLastDirectory = true
sUSER_Work = ConvertFROMUrl(sURL)
endif
end function
function F_getfileName(sSheetName)
F_getfileName = "/"+sSheetname+".pdf"
end function
Function F_Get_PrintAreas
oSheets = ThisComponent.Sheets
DIM ALL_PrintAreas(oSheets.count - 1) as Variant
for i = 0 to oSheets.count - 1
oSheet = oSheets(i)
oSheetPrintareas = oSheet.PrintAreas
ALL_PrintAreas(i) = oSheetPrintareas
next i
F_Get_PrintAreas = ALL_PrintAreas
end function
Sub S_Delete_PrintAreas
oSheets = ThisComponent.Sheets
for i = 0 to osheets.count - 1
osheet = oSheets(i)
osheet.setPrintAreas(Array())
next i
end Sub
sub S_Store_to_PDF(nSheet,aPrintAreas,S_Folder_URL)
Dim myProps(0) as New com.sun.star.beans.PropertyValue
myProps(0).Name="FilterName"
myProps(0).Value = "calc_pdf_Export"
osheets = thisComponent.Sheets(nSheet)
oSheet = osheets(nSheet)
sSheetName = oSheet.Name
sFileName = F_getfileName(sSheetName)
oSheet.setPrintAreas(aPrintAreas)
sUrl = converttoURL(S_Folder_URL & sFilename) 'Speicherpfad zusammensetzen
ThisComponent.storetoUrl(sUrl,myProps()) 'Speichern
oSheet.setPrintAreas(Array())
end sub
Sub F_Set_PrintAreas(ALL_PrintAreas)
oSheets = ThisComponent.Sheets
for i = 0 to oSheets.count - 1
oSheet = oSheets(i)
oSheet.PrintAreas = ALL_PrintAreas(i)
next i
end Sub
Damit die Makros laufen dürfen, stellst du unter Extras/Optionen/LibreOffice/Sicherheit/Makrosicherheit mindestens die Stufe "Mittel" ein, dann wirst du beim Öffnen von Dokumenten gefragt, ob du Makros ausführen möchtest.
Nimm einfach dieses Dokument, kopiere deine Tabellenblätter hinein, überprüfe die Druckbereiche und setze sie ggf. neu. WICHTIG: Je Tabellenblatt genau einen Druckbereich! Auf Leer- und Sonderzeichen in den Tabellennamen verzichten!
Gruß R
PERFEKT!!! 
