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

Kod: Zaznacz cały

REM  *****  BASIC  *****
Option Explicit

' Katalog bazowy dokumentów
Const csBaseDocDir As String = "c:\Dowody"
Const csSheetName As String = "Arkusz1"
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(1,2) ' B3 Data dok.
 dDate =  oCell.getValue()
 
 oCell = oSheet.getCellByPosition(5,7) ' 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 +  _
                      sPathSep + sDirDay 
 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