Fórum pro uživatele kancelářského balíku OpenOffice | LibreOffice
 

#1 12. 5. 2025 13:40:12

InterFlag
Člen
Registrace: 2. 10. 2008
Příspěvků: 11

Libreoffice ignoruje setDefaultName FilePicker, SystemFilePicker

Vytvořil jsem makro, které by mělo ukládat soubor do CSV s mým nastavením.
Chtěl jsem, aby se mi zobrazilo dialogové okno s názvem souboru předvyplněný názvem původního souboru.
A zde je problém. Pokud použiju FilePicker a SystemFilePicker, tak je jméno souboru prázdné.
Pokud ale použiju OfficeFilePicker, jméno tam mám.
Ještě jsem zjistil, že když vypnu nativní dialogy OS v LibreOffice, začne FilePicker  respektovat setDefaultName.
Ale ten dialog je nehezký, proto to uvádím, že to umí fungovat.

Pokud to chcete zkusit, tak:
Otevřete LibreOffice a přejděte na Nástroje → Možnosti → LibreOffice → Pokročilé.
Klikněte na Otevřít konfiguraci experta.
Do vyhledávacího pole zadejte UseSystemFileDialog a vyhledejte tuto položku.
Pokud je hodnota nastavena na true, změňte ji na false a potvrďte změnu.
Restartujte LibreOffice a zkuste znovu spustit tento můj script.

Sub ExportToCSV
    Dim oDoc As Object
    Dim sURL As String
    Dim FileN As String
    Dim sSelectedFile As String
    Dim fileProps(3) As New com.sun.star.beans.PropertyValue
    Dim oDlg As Object
    Dim aUrl() As Variant
    
    ' Získání aktuálního dokumentu
    oDoc = ThisComponent
    If oDoc Is Nothing Then
        MsgBox "Dokument není otevřen nebo inicializován.", 16, "Chyba"
        Exit Sub
    End If
    
    ' Načtení knihovny Tools pro GetFileNameWithoutExtension
    GlobalScope.BasicLibraries.LoadLibrary("Tools")
    
    ' Zjištění URL aktuálního dokumentu
    sURL = oDoc.getURL()
    If sURL = "" Then
        MsgBox "Dokument není uložen. Uložte dokument a zkuste to znovu.", 16, "Chyba"
        Exit Sub
    End If
    
    Dim sDefaultFileName As String
    sDefaultFileName = GetFileNameWithoutExtension(FileNameoutofPath(sURL))
    ' Manuálně ořízni, pokud je potřeba
    Dim pos As Integer
    pos = InStr(sDefaultFileName, ".")
    If pos > 0 Then
        sDefaultFileName = Left(sDefaultFileName, pos - 1)
    End If
    ' Odstranění "CAF -" pokud je přítomno
    If Left(sDefaultFileName, 5) = "CAF -" Then
        sDefaultFileName = Mid(sDefaultFileName, 6)
    End If

    ' Inicializace FilePickeru
    oDlg = createUnoService("com.sun.star.ui.dialogs.FilePicker")
    Dim listAny(0) As Variant
    listAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_SIMPLE
    oDlg.initialize(listAny())
    
    oDlg.setDisplayDirectory(ConvertFromURL(DirectoryNameoutofPath(sURL, "/")))
    oDlg.setDefaultName(sDefaultFileName) ' Nastavení výchozího názvu
    oDlg.appendFilter("Text CSV (*.csv)", "*.csv")
    oDlg.setCurrentFilter("Text CSV (*.csv)")
  
    ' Zobrazení dialogu
    If oDlg.execute() Then
        aUrl = oDlg.getFiles()
        sSelectedFile = aUrl(0)
        If LCase(Right(sSelectedFile, 4)) <> ".csv" Then
            sSelectedFile = sSelectedFile & ".csv"
        End If
        FileN = ConvertToURL(sSelectedFile)
    Else
        Exit Sub
    End If
    
    ' Nastavení parametrů exportu
    fileProps(0).Name = "FilterName"
    fileProps(0).Value = "Text - txt - csv (StarCalc)"
    fileProps(1).Name = "FilterOptions"
    fileProps(1).Value = "44,0,76,1"
    fileProps(2).Name = "Overwrite"
    fileProps(2).Value = True
    fileProps(3).Name = "OutputEncoding"
    fileProps(3).Value = "UTF-8"
    
    On Error GoTo ErrorHandle
    oDoc.storeToURL(FileN, fileProps())
    MsgBox "Soubor byl uložen jako: " & ConvertFromURL(FileN), 64, "Úspěch"
    Exit Sub
    
ErrorHandle:
    MsgBox "Chyba při ukládání: " & Err.Description & Chr(13) & _
           "Možná je soubor " & ConvertFromURL(FileN) & " otevřen v jiném okně?", 16, "Chyba"
End Sub

Editoval InterFlag (12. 5. 2025 13:42:17)

Offline

Zápatí