modyfikowana nazwa pliku do schowka

[Judykator]

Chciałbym przesiąść się z Worda na Writera. W VBA mam makro które jest dla mnie bardzo użyteczne i które chciałbym mieć również w Libre Office

W VBA wygląda to tak:

Kod: Zaznacz cały

Public Sub Przypisz_wlasciwosci()
    Dim nazwa As String     ' nazwa pliku
    Dim tytul As String     ' przyszłe pole tytuł
    Dim temat As String     ' przyszłe pole temat
    Dim nawias As Long      ' numer litery gdzie jest nawias kończący tytuł
    Dim dlugosc As Long     ' Długość nazwy
    ' pobranie nazwy pliku
    ActiveDocument.Save
    nazwa = ActiveDocument.Name
    ' wyszukwanie końca tytułu
    nawias = InStr(nazwa, ")")
    ' małe zabezpieczenie
    If nawias = 0 Then End
    ' przypisanie tytułu pierwotnego
    tytul = Left(nazwa, nawias - 1)
    ' operacje na tytule
    tytul = Replace(tytul, "-", "/")
    tytul = Replace(tytul, "p/ko", "p-ko")
    tytul = Replace(tytul, " (", ", ")
    ' przypisanie danych
    ' nowe 2012-03-27
    Dim NazwaPliku As New DataObject
    Set NazwaPliku = New DataObject
    NazwaPliku.settext (ActiveDocument.BuiltInDocumentProperties(wdPropertyTitle))
    NazwaPliku.PutInClipboard
End Sub

Generalnie chodzi w tym o to by z nazwy pliku stworzyć ciąg znaków i wstawić go do schowka.
Stworzenie ciągu znaków ma polegać na
1 wczytaniu nazwy aktualnego edytowanego pliku - bez ścieżki
2. utworzeniu tekstu z nazwy pliku o długości - aż do wystąpienia pierwszego znaku ")" [w pożądanym ciągu nawis ten już nie znajduje się]
3. zamianie w uzyskanym ciągu liter znaków "-" na "/"
3. zmianie w uzyskanym ciągu liter zwrotu "p/ko" na "p-ko"
4. zmianie w uzyskanym ciągu liter zwrotu " (" [spacja z otwarciem nawisu] na ", " [przecinek ze spacją]
5. wstawieniu ostatecznego wyniku do schowka (jak ctrl+C)

Czy ktoś może mi to zakodować jako makro LibreOffice ?

[belstar]

W nowej wersji bez kopiowania do schowka:

Kod: Zaznacz cały

Public Sub Przypisz_wlasciwosci()
    Dim nazwa As String     ' nazwa pliku
    Dim tytul As String     ' przyszłe pole tytuł
    Dim temat As String     ' przyszłe pole temat
    Dim nawias As Long      ' numer litery gdzie jest nawias kończący tytuł
    Dim dlugosc As Long     ' Długość nazwy
    ' pobranie nazwy pliku
    'ActiveDocument.Save
    ThisComponent.store()
    'nazwa = ActiveDocument.Name
    nazwa = ThisComponent.getTitle()
    ' wyszukwanie końca tytułu
    nawias = InStr(nazwa, ")")
    ' małe zabezpieczenie
    If nawias = 0 Then End
    ' przypisanie tytułu pierwotnego
    tytul = Left(nazwa, nawias - 1)
    ' operacje na tytule
    tytul = Replace(tytul, "-", "/")
    tytul = Replace(tytul, "p/ko", "p-ko")
    tytul = Replace(tytul, " (", ", ")
    ' przypisanie danych
    ' nowe 2012-03-27
    'Dim NazwaPliku As New DataObject
    'Set NazwaPliku = New DataObject
    'NazwaPliku.settext (ActiveDocument.BuiltInDocumentProperties(wdPropertyTitle))
    'NazwaPliku.PutInClipboard
    'Tu wstaw odwołanie do procedury Clipper
End Sub

Miejsce gdzie wstawić wywołanie do procedury poniżej zaznaczyłem w kodzie, ale przed tym musisz ją trochę dostosować do swoich potrzeb, no chyba ze nie wiesz jak, ale za to wiesz jak spytać. I jeszcze pobawić się z rozszerzeniem nazwy pliku.

Kod: Zaznacz cały

'Na podstawie
'https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=30800&p=140322&hilit=PutInClipboard#p140391

Global ClipString As String

Sub Clipper
   Dim cBoard As Object
   Dim cTrans As Object
   Dim null As Object
      
   cBoard = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
   cTrans = createUnoListener("TR_", "com.sun.star.datatransfer.XTransferable")    
   ClipString = "To zdanie jest teraz w schowku."
   cBoard.setContents(cTrans, null)
End Sub

function TR_getTransferData( aFlavor as com.sun.star.datatransfer.DataFlavor )
   if (aFlavor.MimeType = "text/plain;charset=utf-16") then
        TR_getTransferData = ClipString
     endif
end function

function TR_getTransferDataFlavors()
   Dim aF as new com.sun.star.datatransfer.DataFlavor
   aF.MimeType = "text/plain;charset=utf-16"
   aF.HumanPresentableName = "Unicode-Text"
   TR_getTransferDataFlavors = Array(aF)
end function

function TR_isDataFlavorSupported(aFlavor as com.sun.star.datatransfer.DataFlavor) as Boolean
   TR_isDataFlavorSupported = (aFlavor.MimeType = "text/plain;charset=utf-16")
end function

[Judykator]

O ile w VBA jestem w stanie coś małego napisać, to w open office ni w ząb. Mogę prosić o gotowca? Potrafię wstawić moduł do szablonu i przypisać skrót klawiaturowy czy inny sposób uruchomiania.

[belstar]

Podaj mi przykładowe nazwy plików, do testów.

[belstar]

Gotowiec gotowy.

[Judykator]

Dziękuje bardzo. Działa. Co prawda nazwa pokazuje się w schowku (czy w moim menadżerze schowka - Ditto) po około 5 sekundach.

Nazwy modułów mogę zmienić?

[belstar]

Nazwy modułów mogę zmienić?

Możesz.
Co do opóźnienia twojego menadżera schowka to nie mogę się wypowiadać bo nie używam.