Forum społeczności użytkowników OpenOffice i LibreOffice

Kod: Zaznacz cały

' Katalog bazowy dokumentów
Const csBaseDocDir As String = "c:\Dowody"
Const csSheetName As String = "Faktura"
Const csNumberFormat As String = "000000"

Private sPathSep As String

' ========================================================
' SaveSheet
' ========================================================
Sub SaveSheet
 Dim oDoc As Object
 Dim oSheet As Object
 Dim oCell As Object
 Dim dDate As Date
 Dim sDocNumber As String
 
 Dim sDateISO As String
 Dim sDirDay As String
 Dim sDirMonth As String
 Dim sDirYear As String
 Dim sDir As String

 sPathSep = GetPathSeparator()
 
 oDoc = ThisComponent
 oSheet = oDoc.Sheets.getByName(csSheetName)

 oCell = oSheet.getCellByPosition(10,1) ' B3 Data dok.
 dDate =  oCell.getValue()
 
 oCell = oSheet.getCellByPosition(15,2) ' F8 Numer dok.
  sDocNumber = oCell.getString()  ' wartosc jako tekst
' sDocNumber = Format(oCell.getValue(), csNumberFormat) ' wartosc z formatowaniem
   
 sDateISO = CDateToISO(dDate)
 sDirDay = Right(sDateISO,2)
 sDirMonth = Mid(sDateISO, 5, 2)
 sDirYear = Left(sDateISO, 4)
 sDir = csBaseDocDir + sPathSep + sDirYear  +  _
                      sPathSep + sDirMonth 
 SaveDocument sDir,  sDocNumber + ".ods"
 
End Sub

' ========================================================
' SaveDocument
' ========================================================
Sub SaveDocument( sDirName As String, sFileName As String )

 
  Dim args(0) As New com.sun.star.beans.PropertyValue
  Dim sURL As String
  
  MkDir(sDirName)
  
  sURL=ConvertToURL(sDirName + sPathSep + sFileName)
  ThisComponent.storeToURL(sURL, args())
End Sub

Kod: Zaznacz cały

sub Kopiuj_Zakres
	oDoc = ThisComponent
	oSheet = oDoc.Sheets.getByName("A")
	oSourceRange = oSheet.getCellRangeByName("A1:C26")'zmień zaakres
	oDataArray = oSourceRange.getDataArray
   
	oDestSheet = oDoc.Sheets.getByName("B")
	oDestRange = oDestSheet.getCellRangeByName("A1:c26")'zmień zakres
	oDestRange.setDataArray(oDataArray)
	'uauwanie zawartości zakresu
	'tu wstaw wywolanie swojej procedury
	With com.sun.star.sheet.CellFlags
  		flagi = .STRING + .VALUE + .DATETIME + .FORMULA
	End With 
	oDestRange.clearContents(flagi)
end sub

Kod: Zaznacz cały

Sub CopyPDF
   oDoc = Thiscomponent 'the document running the macro
   oSheet = oDoc.getCurrentController().getActiveSheet() ' the active sheet
   'oDoc.g1etCurrentController.Select oSheet
  'print osheet.name()
   cFile = ("/home/Twój_katalog/"& oSheet.name()&".pdf")'Windows c:\COŚ_TAM
   cUrl = ConvertToUrl( cFile )
   oDoc.storeToUrl( cUrl, Array( MakePropertyValue( "FilterName", "calc_pdf_Export", "Selection,0,0")))
End Sub

Function MakePropertyValue( Optional cName As String, Optional uValue ) As com.sun.star.beans.PropertyValue
   oPropertyValue = createUnoStruct( "com.sun.star.beans.PropertyValue" )
   If Not IsMissing( cName ) Then
      oPropertyValue.Name = cName
   EndIf
   If Not IsMissing( uValue ) Then
      oPropertyValue.Value = uValue
   EndIf
   MakePropertyValue() = oPropertyValue
End Function