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

#1 26. 8. 2011 11:55:40

Billlly_Samotar
Člen
Registrace: 26. 8. 2011
Příspěvků: 18

Vyřešeno - Vlozeni hodnoty ze schranky do nazvu souboru

Dobrý den.
.
Mám v Base vytvořenou Databázi, v ní X formulářů, dotazů a sestav a chtěl bych danou sestavu uložit jako samostatný soubor. Ideálně kdyby bylo možno z dané Sestavy určitou hodnotu vytáhnout (to se mi povedlo a mám ji ve schránce), ale s touto hodnotou bych chtěl dále pracovat. Ne ji vložit do daného dokumentu jako text, ale tuto hodnotu ze schránky uložit do nějaké proměnné nebo rovnou do hlavičky souboru (POPIS - TITLE). Níže přikládám dosavadní makro.
.
Předem díky za rychlou pomoc.
.
Zde slíbené makro:

sub Odemceni_Posun_na_dane_misto_Oznaceni_Copy_Save
rem ----------------------------------------------------------------------
' Definice proměných
dim document   as object
dim dispatcher as object
dim args1(1) as new com.sun.star.beans.PropertyValue
dim args2(1) as new com.sun.star.beans.PropertyValue
dim args3(2) as new com.sun.star.beans.PropertyValue
dim args4(9) as new com.sun.star.beans.PropertyValue
rem ----------------------------------------------------------------------
' Nastavení dokumentu
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
' Přepne dokument do formátu Editace (původně jen pro čtení)
dispatcher.executeDispatch(document, ".uno:EditDoc", "", 0, Array())

rem ----------------------------------------------------------------------
' Přesun na určitou pozice (v našem případě před "Číslo RP")
' tři řádky dolů
args1(0).Name = "Count"
args1(0).Value = 3
args1(1).Name = "Select"
args1(1).Value = false
dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args1())
' 26 znaků doprava
args2(0).Name = "Count"
args2(0).Value = 26
args2(1).Name = "Select"
args2(1).Value = false
dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args2())

rem ----------------------------------------------------------------------
' Označení určité pozice (momentálně "Čísla RP" - 13znaků)
args3(0).Name = "Count"
args3(0).Value = 13
args3(1).Name = "Select"
args3(1).Value = true
dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args3())
' Uložení do schránky
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
' Nastavení "Čísla RP" do hlavičky dokumentu (POPIS - TITLE)
args4(0).Name = "Properties.UseUserData"
args4(0).Value = true
args4(1).Name = "Properties.DeleteUserData"
args4(1).Value = false
args4(2).Name = "Properties.Title"
args4(2).Value = "TEST" 'Tady místo TEST bych rád použil hodnotu ze SCHRÁNKY.
args4(3).Name = "Properties.Subject"
args4(3).Value = "Reklamační protokol"
args4(4).Name = "Properties.KeyWords"
args4(4).Value = ""
args4(5).Name = "Properties.Description"
args4(5).Value = ""
args4(6).Name = "Properties.AutoReload"
args4(6).Value = false
args4(7).Name = "Properties.AutoReloadTime"
args4(7).Value = 0
args4(8).Name = "Properties.AutoReloadURL"
args4(8).Value = ""
args4(9).Name = "Properties.AutoReloadFrame"
args4(9).Value = ""

dispatcher.executeDispatch(document, ".uno:SetDocumentProperties", "", 0, args4())
end sub

Editoval Billlly_Samotar (31. 8. 2011 12:55:18)

Offline

#2 26. 8. 2011 21:22:53

Billlly_Samotar
Člen
Registrace: 26. 8. 2011
Příspěvků: 18

Re: Vyřešeno - Vlozeni hodnoty ze schranky do nazvu souboru

Tak kdyby jste věděli nějaký lepší návod, ale jinak jsem hledal až nakonec na japonských stránkách jsem našel funkční makro, které mi dokázalo udělat přesně co potřebuji, takže úplně finální verze makra je (kdyby někdo potřeboval také použít, ale jistě bude znát kratší a lepší):
.

sub Odemceni_Posun_na_dane_misto_Oznaceni_Copy_Save
rem ----------------------------------------------------------------------
' Definice proměných
dim document   as object
dim dispatcher as object
dim args1(1) as new com.sun.star.beans.PropertyValue
dim args2(1) as new com.sun.star.beans.PropertyValue
dim args3(2) as new com.sun.star.beans.PropertyValue
dim args4(9) as new com.sun.star.beans.PropertyValue
rem ----------------------------------------------------------------------
' Nastavení dokumentu
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
' Přepne dokument do formátu Editace (původně jen pro čtení)
dispatcher.executeDispatch(document, ".uno:EditDoc", "", 0, Array())

rem ----------------------------------------------------------------------
' Přesun na určitou pozice (v našem případě před "Číslo RP")
' tři řádky dolů - neoznačuje
args1(0).Name = "Count"
args1(0).Value = 3
args1(1).Name = "Select"
args1(1).Value = false
dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args1())
' 26 znaků doprava - neoznačuje
args2(0).Name = "Count"
args2(0).Value = 26
args2(1).Name = "Select"
args2(1).Value = false
dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args2())

rem ----------------------------------------------------------------------
' Označení určité pozice (momentálně "Čísla RP" - 13znaků)
args3(0).Name = "Count"
args3(0).Value = 13
args3(1).Name = "Select"
args3(1).Value = true
dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, args3())
' Uložení do schránky
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
' Vloží hodnotu ze schánky
 oClip = CreateUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
  oTransfer = oClip.getContents()

  ' sequence of com.sun.star.datatransfer.DataFlavor
  aDataFlavors = oTransfer.getTransferDataFlavors()
  bType = False
  For i = 0 To UBound(aDataFlavors) Step 1
    aDataFlavor = aDataFlavors(i)
    If aDataFlavor.MimeType = "text/plain;charset=utf-16" Then
      bType = True
      Exit For
    End If
  Next
  If bType Then
    ' convert utf-16 to UNO string
    oConverter = CreateUnoService( _
        "com.sun.star.script.Converter")
    Hodnota_ze_schranky = oConverter.convertToSimpleType( _
        oTransfer.getTransferData(aDataFlavor), _
        com.sun.star.uno.TypeClass.STRING)
'    MsgBox Hodnota_ze_schranky 'Pro otestování co je aktuálně ve schránce uloženo
  End If

rem ----------------------------------------------------------------------
' Nastavení "Čísla RP" do hlavičky dokumentu (POPIS - TITLE)
args4(0).Name = "Properties.UseUserData"
args4(0).Value = true
args4(1).Name = "Properties.DeleteUserData"
args4(1).Value = false
args4(2).Name = "Properties.Title"
args4(2).Value = Hodnota_ze_schranky '<-----------------ZDE je hodnota ze schránky!
args4(3).Name = "Properties.Subject"
args4(3).Value = "Reklamační protokol"
args4(4).Name = "Properties.KeyWords"
args4(4).Value = "Reklamacni protokol"
args4(5).Name = "Properties.Description"
args4(5).Value = "MTL Cable spol. s r.o."
args4(6).Name = "Properties.AutoReload"
args4(6).Value = false
args4(7).Name = "Properties.AutoReloadTime"
args4(7).Value = 0
args4(8).Name = "Properties.AutoReloadURL"
args4(8).Value = ""
args4(9).Name = "Properties.AutoReloadFrame"
args4(9).Value = ""

dispatcher.executeDispatch(document, ".uno:SetDocumentProperties", "", 0, args4())
end sub

Offline

Zápatí