| blob | bba8b3c21bd52e8997c47c584f8a5691266d559d |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Document" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === The SFDocuments library is one of the associated libraries. ===
6 REM === Full documentation is available on https://help.libreoffice.org/ ===
7 REM =======================================================================================================================
9 Option Compatible
10 Option ClassModule
12 Option Explicit
14 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
15 ''' SF_Document
16 ''' ===========
17 '''
18 ''' The SFDocuments library gathers a number of methods and properties making easy
19 ''' managing and manipulating LibreOffice documents
20 '''
21 ''' Some methods are generic for all types of documents: they are combined in the
22 ''' current SF_Document module
23 ''' - saving, closing documents
24 ''' - accessing their standard or custom properties
25 ''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Base, ...
26 '''
27 ''' Documents might contain forms. The current service gives access to the "SFDocuments.Form" service
28 '''
29 ''' To workaround the absence of class inheritance in LibreOffice Basic, some redundancy is necessary
30 ''' Each subclass MUST implement also the generic methods and properties, even if they only call
31 ''' the parent methods and properties implemented below
32 ''' They should also duplicate some generic private members as a subset of their own set of members
33 '''
34 ''' The current module is closely related to the "UI" and "FileSystem" services
35 ''' of the ScriptForge library
36 '''
37 ''' Service invocation examples:
39 ''' Dim ui As Object, oDoc As Object
45 ''' Dim oDoc As Object
46 ''' Set oDoc = CreateScriptService("SFDocuments.Document", "Untitled 1") ' Default = ActiveWindow
48 '''
49 ''' Detailed user documentation:
50 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_document.html?DbPAR=BASIC
51 '''
52 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
54 REM ================================================================== EXCEPTIONS
63 REM ============================================================= PRIVATE MEMBERS
65 Private [Me] As Object
66 Private [_Parent] As Object
67 Private [_SubClass] As Object ' Subclass instance
68 Private ObjectType As String ' Must be DOCUMENT
69 Private ServiceName As String
71 ' Window description
72 Private _Component As Object ' com.sun.star.lang.XComponent
73 Private _Frame As Object ' com.sun.star.comp.framework.Frame
74 Private _WindowName As String ' Object Name
75 Private _WindowTitle As String ' Only mean to identify new documents
76 Private _WindowFileName As String ' URL of file name
77 Private _DocumentType As String ' Writer, Calc, ...
79 ' Properties (work variables - real properties could have been set manually by user)
80 Private _DocumentProperties As Object ' Dictionary of document properties
81 Private _CustomProperties As Object ' Dictionary of custom properties
83 REM ============================================================ MODULE CONSTANTS
87 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
89 REM -----------------------------------------------------------------------------
90 Private Sub Class_Initialize()
91 Set [Me] = Nothing
92 Set [_Parent] = Nothing
93 Set [_SubClass] = Nothing
96 Set _Component = Nothing
97 Set _Frame = Nothing
98 _WindowName = ""
99 _WindowTitle = ""
100 _WindowFileName = ""
101 _DocumentType = ""
102 Set _DocumentProperties = Nothing
103 Set _CustomProperties = Nothing
104 End Sub ' SFDocuments.SF_Document Constructor
106 REM -----------------------------------------------------------------------------
107 Private Sub Class_Terminate()
108 Call Class_Initialize()
109 End Sub ' SFDocuments.SF_Document Destructor
111 REM -----------------------------------------------------------------------------
112 Public Function Dispose() As Variant
113 Call Class_Terminate()
114 Set Dispose = Nothing
115 End Function ' SFDocuments.SF_Document Explicit Destructor
117 REM ================================================================== PROPERTIES
119 REM -----------------------------------------------------------------------------
120 Property Get CustomProperties() As Variant
121 ''' Returns a dictionary of all custom properties of the document
123 End Property ' SFDocuments.SF_Document.CustomProperties
125 REM -----------------------------------------------------------------------------
126 Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant)
127 ''' Sets the updatable custom properties
128 ''' The argument is a dictionary
130 Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue
131 Dim vCustomProperties As Variant ' Alias of argument
132 Dim oUserdefinedProperties As Object ' Custom properties object
133 Dim vOldPropertyValues As Variant ' Array of (to remove) existing user defined properties
134 Dim oProperty As Object ' Single com.sun.star.beans.PropertyValues
135 Dim sProperty As String ' Property name
136 Dim vKeys As Variant ' Array of dictionary keys
137 Dim vItems As Variant ' Array of dictionary items
138 Dim vValue As Variant ' Value to store in property
139 Dim iAttribute As Integer ' com.sun.star.beans.PropertyAttribute.REMOVEABLE
140 Dim i As Long
144 On Local Error GoTo Catch
146 Check:
147 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
148 If Not _IsStillAlive(True) Then GoTo Finally
149 If Not ScriptForge.SF_Utils._Validate(pvCustomProperties, "CustomProperties", ScriptForge.V_OBJECT, , , "DICTIONARY") Then GoTo Finally
150 End If
152 Try:
153 Set oUserDefinedProperties = _Component.getDocumentProperties().UserDefinedProperties
155 Set vCustomProperties = pvCustomProperties ' To avoid "Object variable not set" error
156 With vCustomProperties
158 ' All existing custom properties must first be removed to avoid type conflicts
159 vOldPropertyValues = oUserDefinedProperties.getPropertyValues
160 For Each oProperty In vOldPropertyValues
161 sProperty = oProperty.Name
162 oUserDefinedProperties.removeProperty(sProperty)
163 Next oProperty
165 ' Insert new properties one by one after type adjustment (dates, arrays, numbers)
166 vKeys = .Keys
167 vItems = .Items
168 iAttribute = com.sun.star.beans.PropertyAttribute.REMOVEABLE
169 For i = 0 To UBound(vKeys)
170 If VarType(vItems(i)) = V_DATE Then
171 vValue = ScriptForge.SF_Utils._CDateToUnoDate(vItems(i))
172 ElseIf IsArray(vItems(i)) Then
173 vValue = Null
174 ElseIf ScriptForge.SF_Utils._VarTypeExt(vItems(i)) = ScriptForge.V_NUMERIC Then
176 Else
177 vValue = vItems(i)
178 End If
179 oUserDefinedProperties.addProperty(vKeys(i), iAttribute, vValue)
180 Next i
182 ' Declare the document as changed
183 _Component.setModified(True)
184 End With
186 ' Reload custom properties in current object instance
189 Finally:
190 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
191 Exit Property
192 Catch:
193 GoTo Finally
194 End Property ' SFDocuments.SF_Document.CustomProperties
196 REM -----------------------------------------------------------------------------
197 Property Get Description() As Variant
198 ''' Returns the updatable document property Description
200 End Property ' SFDocuments.SF_Document.Description
202 REM -----------------------------------------------------------------------------
203 Property Let Description(Optional ByVal pvDescription As Variant)
204 ''' Sets the updatable document property Description
205 ''' If multilined, separate lines by "\n" escape sequence or by hard breaks
207 Dim sDescription As String ' Alias of pvDescription
211 Check:
212 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
213 If Not _IsStillAlive(True) Then GoTo Finally
214 If Not ScriptForge.SF_Utils._Validate(pvDescription, "Description", V_STRING) Then GoTo Finally
215 End If
217 Try:
218 ' Update in UNO component object and in current instance
220 _Component.DocumentProperties.Description = sDescription
221 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Description", sdescription)
223 Finally:
224 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
225 Exit Property
226 End Property ' SFDocuments.SF_Document.Description
228 REM -----------------------------------------------------------------------------
229 Property Get DocumentProperties() As Variant
230 ''' Returns a dictionary of all standard document properties, custom properties are excluded
232 End Property ' SFDocuments.SF_Document.DocumentProperties
234 REM -----------------------------------------------------------------------------
235 Property Get DocumentType() As String
236 ''' Returns "Base", "Calc", "Draw", ... or "Writer"
238 End Property ' SFDocuments.SF_Document.DocumentType
240 REM -----------------------------------------------------------------------------
241 Property Get ExportFilters() As Variant
242 ''' Returns the list of the export filter names applicable to the current document
243 ''' as a zero-based array of strings
244 ''' Import/Export filters are included
246 End Property ' SFDocuments.SF_Document.ExportFilters
248 REM -----------------------------------------------------------------------------
249 Property Get ImportFilters() As Variant
250 ''' Returns the list of the import filter names applicable to the current document
251 ''' as a zero-based array of strings
252 ''' Import/Export filters are included
254 End Property ' SFDocuments.SF_Document.ImportFilters
256 REM -----------------------------------------------------------------------------
257 Property Get IsBase() As Boolean
259 End Property ' SFDocuments.SF_Document.IsBase
261 REM -----------------------------------------------------------------------------
262 Property Get IsCalc() As Boolean
264 End Property ' SFDocuments.SF_Document.IsCalc
266 REM -----------------------------------------------------------------------------
267 Property Get IsDraw() As Boolean
269 End Property ' SFDocuments.SF_Document.IsDraw
271 REM -----------------------------------------------------------------------------
272 Property Get IsImpress() As Boolean
274 End Property ' SFDocuments.SF_Document.IsImpress
276 REM -----------------------------------------------------------------------------
277 Property Get IsMath() As Boolean
279 End Property ' SFDocuments.SF_Document.IsMath
281 REM -----------------------------------------------------------------------------
282 Property Get IsWriter() As Boolean
284 End Property ' SFDocuments.SF_Document.IsWriter
286 REM -----------------------------------------------------------------------------
287 Property Get Keywords() As Variant
288 ''' Returns the updatable document property Keywords
290 End Property ' SFDocuments.SF_Document.Keywords
292 REM -----------------------------------------------------------------------------
293 Property Let Keywords(Optional ByVal pvKeywords As Variant)
294 ''' Sets the updatable document property Keywords
296 Dim vKeywords As Variant ' Alias of pvKeywords
300 Check:
301 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
302 If Not _IsStillAlive(True) Then GoTo Finally
303 If Not ScriptForge.SF_Utils._Validate(pvKeywords, "Keywords", V_STRING) Then GoTo Finally
304 End If
306 Try:
307 ' Update in UNO component object and in current instance
309 _Component.DocumentProperties.Keywords = vKeywords
310 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Keywords", Join(vKeywords, ", "))
312 Finally:
313 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
314 Exit Property
315 End Property ' SFDocuments.SF_Document.Keywords
317 REM -----------------------------------------------------------------------------
318 Property Get Readonly() As Boolean
319 ''' Returns True if the document must not be modified
321 End Property ' SFDocuments.SF_Document.Readonly
323 REM -----------------------------------------------------------------------------
324 Property Get Subject() As Variant
325 ''' Returns the updatable document property Subject
327 End Property ' SFDocuments.SF_Document.Subject
329 REM -----------------------------------------------------------------------------
330 Property Let Subject(Optional ByVal pvSubject As Variant)
331 ''' Sets the updatable document property Subject
336 Check:
337 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
338 If Not _IsStillAlive(True) Then GoTo Finally
339 If Not ScriptForge.SF_Utils._Validate(pvSubject, "Subject", V_STRING) Then GoTo Finally
340 End If
342 Try:
343 ' Update in UNO component object and in current instance
344 _Component.DocumentProperties.Subject = pvSubject
345 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Subject", pvSubject)
347 Finally:
348 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
349 Exit Property
350 End Property ' SFDocuments.SF_Document.Subject
352 REM -----------------------------------------------------------------------------
353 Property Get Title() As Variant
354 ''' Returns the updatable document property Title
356 End Property ' SFDocuments.SF_Document.Title
358 REM -----------------------------------------------------------------------------
359 Property Let Title(Optional ByVal pvTitle As Variant)
360 ''' Sets the updatable document property Title
365 Check:
366 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
367 If Not _IsStillAlive(True) Then GoTo Finally
369 End If
371 Try:
372 ' Update in UNO component object and in current instance
373 _Component.DocumentProperties.Title = pvTitle
374 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Title", pvTitle)
376 Finally:
377 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
378 Exit Property
379 End Property ' SFDocuments.SF_Document.Title
381 REM -----------------------------------------------------------------------------
382 Property Get XComponent() As Variant
383 ''' Returns the com.sun.star.lang.XComponent UNO object representing the document
385 End Property ' SFDocuments.SF_Document.XComponent
387 REM ===================================================================== METHODS
389 REM -----------------------------------------------------------------------------
390 Public Function Activate() As Boolean
391 ''' Make the current document active
392 ''' Args:
393 ''' Returns:
394 ''' True if the document could be activated
395 ''' Otherwise, there is no change in the actual user interface
396 ''' Examples:
397 ''' oDoc.Activate()
399 Dim bActivate As Boolean ' Return value
400 Dim oContainer As Object ' com.sun.star.awt.XWindow
402 Const cstSubArgs = ""
404 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
405 bActivate = False
407 Check:
408 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
409 If Not _IsStillAlive() Then GoTo Finally
411 Try:
412 Set oContainer = _Frame.ContainerWindow
413 With oContainer
414 If .isVisible() = False Then .setVisible(True)
415 .IsMinimized = False
416 .setFocus()
417 .toFront() ' Force window change in Linux
419 End With
420 bActivate = True
422 Finally:
423 Activate = bActivate
424 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
425 Exit Function
426 Catch:
427 GoTo Finally
428 End Function ' SFDocuments.SF_Document.Activate
430 REM -----------------------------------------------------------------------------
431 Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean
432 ''' Close the document. Does nothing if the document is already closed
433 ''' regardless of how the document was closed, manually or by program
434 ''' Args:
435 ''' SaveAsk: If True (default), the user is invited to confirm or not the writing of the changes on disk
436 ''' No effect if the document was not modified
437 ''' Returns:
438 ''' False if the user declined to close
439 ''' Examples:
440 ''' If oDoc.CloseDocument() Then
441 ''' ' ...
443 Dim bClosed As Boolean ' return value
444 Dim oDispatch ' com.sun.star.frame.DispatchHelper
448 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
449 bClosed = False
451 Check:
452 If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True
453 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
454 If Not _IsStillAlive() Then GoTo Finally
455 If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", ScriptForge.V_BOOLEAN) Then GoTo Finally
456 End If
458 Try:
459 If SaveAsk And _Component.IsModified Then ' Execute closure with the File/Close menu command
460 Activate()
462 bClosed = _IsStillAlive(, False) ' Do not raise error
463 Else
464 _Frame.close(True)
465 _Frame.dispose()
466 bClosed = True
467 End If
469 Finally:
470 If bClosed Then Dispose()
471 CloseDocument = bClosed
472 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
473 Exit Function
474 Catch:
475 GoTo Finally
476 End Function ' SFDocuments.SF_Document.CloseDocument
478 REM -----------------------------------------------------------------------------
479 Public Function CreateMenu(Optional ByVal MenuHeader As Variant _
480 , Optional ByVal Before As Variant _
481 , Optional ByVal SubmenuChar As Variant _
482 , Optional ByRef _Document As Variant _
483 ) As Object
485 ''' The menu is not intended to be saved neither in the LibreOffice global environment, nor in the document
486 ''' The method returns a SFWidgets.Menu instance. Its methods let define the menu further.
487 ''' Args:
488 ''' MenuHeader: the name/header of the menu
489 ''' Before: the place where to put the new menu on the menubar (string or number >= 1)
492 ''' _Document: undocumented argument to designate the document where the menu will be located
493 ''' Returns:
494 ''' A SFWidgets.Menu instance or Nothing
495 ''' Examples:
496 ''' Dim oMenu As Object
497 ''' Set oMenu = oDoc.CreateMenu("My menu", Before := "Styles")
498 ''' With oMenu
500 ''' '...
501 ''' .Dispose() ' When definition is complete, the menu instance may be disposed
502 ''' End With
503 ''' ' ...
505 Dim oMenu As Object ' return value
507 Const cstSubArgs = "MenuHeader, [Before=""""], [SubmenuChar="">""]"
509 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
510 Set oMenu = Nothing
512 Check:
513 If IsMissing(Before) Or IsEmpty(Before) Then Before = ""
514 If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = ""
515 If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component
517 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
518 If Not _IsStillAlive() Then GoTo Finally
519 If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
521 If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
522 End If
524 Try:
525 Set oMenu = ScriptForge.SF_Services.CreateScriptService("SFWidgets.Menu", _Document, MenuHeader, Before, SubmenuChar)
527 Finally:
528 Set CreateMenu = oMenu
529 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
530 Exit Function
531 Catch:
532 GoTo Finally
533 End Function ' SFDocuments.SF_Document.CreateMenu
535 REM -----------------------------------------------------------------------------
536 Public Function ExportAsPDF(Optional ByVal FileName As Variant _
537 , Optional ByVal Overwrite As Variant _
538 , Optional ByVal Pages As Variant _
539 , Optional ByVal Password As Variant _
540 , Optional ByVal Watermark As Variant _
541 ) As Boolean
542 ''' Store the document to the given file location in PDF format
543 ''' Args:
544 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
545 ''' Overwrite: True if the destination file may be overwritten (default = False)
546 ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
547 ''' Password: password to open the document
548 ''' Watermark: the text for a watermark to be drawn on every page of the exported PDF file
549 ''' Returns:
550 ''' False if the document could not be saved
551 ''' Exceptions:
552 ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
553 ''' Examples:
556 Dim bSaved As Boolean ' return value
557 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
558 Dim sFile As String ' Alias of FileName
559 Dim sFilter As String ' One of the pdf filter names
560 Dim vFilterData As Variant ' Array of com.sun.star.beans.PropertyValue
561 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
562 Dim FSO As Object ' SF_FileSystem
564 Const cstSubArgs = "FileName, [Overwrite=False], [Pages=""""], [Password=""""], [Watermark=""""]"
566 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
567 bSaved = False
569 Check:
570 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
571 If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
572 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
573 If IsMissing(Watermark) Or IsEmpty(Watermark) Then Watermark = ""
575 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
576 If Not _IsStillAlive() Then GoTo Finally
578 If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
582 End If
584 ' Check destination file overwriting
586 sFile = FSO._ConvertToUrl(FileName)
587 If FSO.FileExists(FileName) Then
588 If Overwrite = False Then GoTo CatchError
590 If oSfa.isReadonly(sFile) Then GoTo CatchError
591 End If
593 Try:
594 ' Setup arguments
596 ' FilterData parameters are added only if they are meaningful
597 vFilterData = Array()
599 vFilterData = ScriptForge.SF_Array.Append(vFilterData _
601 End If
603 vFilterData = ScriptForge.SF_Array.Append(vFilterData _
606 End If
608 vFilterData = ScriptForge.SF_Array.Append(vFilterData _
610 End If
612 ' Finalize properties and export
613 vProperties = Array( _
616 _Component.StoreToURL(sFile, vProperties)
617 bSaved = True
619 Finally:
620 ExportAsPDF = bSaved
621 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
622 Exit Function
623 Catch:
624 GoTo Finally
625 CatchError:
626 ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
628 GoTo Finally
629 End Function ' SFDocuments.SF_Document.ExportAsPDF
631 REM -----------------------------------------------------------------------------
632 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
633 ''' Return the actual value of the given property
634 ''' Args:
635 ''' PropertyName: the name of the property as a string
636 ''' Returns:
637 ''' The actual value of the property
638 ''' If the property does not exist, returns Null
639 ''' Exceptions:
640 ''' see the exceptions of the individual properties
641 ''' Examples:
645 Const cstSubArgs = ""
647 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
648 GetProperty = Null
650 Check:
651 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
652 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
653 End If
655 Try:
656 GetProperty = _PropertyGet(PropertyName)
658 Finally:
659 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
660 Exit Function
661 Catch:
662 GoTo Finally
663 End Function ' SFDocuments.SF_Document.GetProperty
665 REM -----------------------------------------------------------------------------
666 Public Function Methods() As Variant
667 ''' Return the list of public methods of the Document service as an array
669 Methods = Array( _
681 )
683 End Function ' SFDocuments.SF_Document.Methods
685 REM -----------------------------------------------------------------------------
686 Public Function PrintOut(Optional ByVal Pages As Variant _
687 , Optional ByVal Copies As Variant _
688 , Optional ByRef _Document As Variant _
689 ) As Boolean
690 ''' Send the content of the document to the printer.
691 ''' The printer might be defined previously by default, by the user or by the SetPrinter() method
692 ''' Args:
693 ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
694 ''' Copies: the number of copies
695 ''' _Document: undocumented argument to designate the document to print when called from a subclass
696 ''' Returns:
697 ''' True when successful
698 ''' Examples:
701 Dim bPrint As Boolean ' Return value
702 Dim vPrintGoal As Variant ' Array of property values
707 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
708 bPrint = False
710 Check:
711 If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
712 If IsMissing(Copies) Or IsEmpty(Copies) Then Copies = 1
713 If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component
715 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
716 If Not _IsStillAlive() Then GoTo Finally
718 If Not ScriptForge.SF_Utils._Validate(Copies, "Copies", ScriptForge.V_NUMERIC) Then GoTo Finally
719 End If
721 Try:
722 vPrintGoal = Array( _
727 )
729 _Document.Print(vPrintGoal)
730 bPrint = True
732 Finally:
733 PrintOut = bPrint
734 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
735 Exit Function
736 Catch:
737 GoTo Finally
738 End Function ' SFDocuments.SF_Document.PrintOut
740 REM -----------------------------------------------------------------------------
741 Public Function Properties() As Variant
742 ''' Return the list or properties of the Document class as an array
744 Properties = Array( _
762 )
764 End Function ' SFDocuments.SF_Document.Properties
766 REM -----------------------------------------------------------------------------
767 Public Function RemoveMenu(Optional ByVal MenuHeader As Variant _
768 , Optional ByRef _Document As Variant _
769 ) As Boolean
771 ''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document
772 ''' Args:
773 ''' MenuHeader: the name/header of the menu, without tilde "~", as a case-sensitive string
774 ''' _Document: undocumented argument to designate the document where the menu is located
775 ''' Returns:
776 ''' True when successful
777 ''' Examples:
779 ''' ' ...
781 Dim bRemove As Boolean ' Return value
782 Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager
783 Dim oMenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar
784 Dim sName As String ' Menu name
785 Dim iMenuId As Integer ' Menu identifier
787 Dim i As Integer
793 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
794 bRemove = False
796 Check:
797 If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component
798 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
799 If Not _IsStillAlive() Then GoTo Finally
800 If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
801 End If
803 Try:
804 Set oLayout = _Document.CurrentController.Frame.LayoutManager
807 ' Search the menu identifier to remove by its name, Mark its position
808 With oMenuBar
809 iMenuPosition = -1
811 iMenuId = .getItemId(i)
812 sName = Replace(.getItemText(iMenuId), cstTilde, "")
813 If MenuHeader= sName Then
814 iMenuPosition = i
815 Exit For
816 End If
817 Next i
818 ' Remove the found menu item
820 .removeItem(iMenuPosition, 1)
821 bRemove = True
822 End If
823 End With
825 Finally:
826 RemoveMenu = bRemove
827 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
828 Exit Function
829 Catch:
830 GoTo Finally
831 End Function ' SFDocuments.SF_Document.RemoveMenu
833 REM -----------------------------------------------------------------------------
834 Public Sub RunCommand(Optional ByVal Command As Variant _
835 , ParamArray Args As Variant _
836 )
837 ''' Run on the current document window the given menu command. The command is executed with or without arguments
838 ''' A few typical commands:
839 ''' Save, SaveAs, ExportToPDF, SetDocumentProperties, Undo, Copy, Paste, ...
840 ''' Dozens can be found on next page: https://wiki.documentfoundation.org/Development/DispatchCommands
841 ''' Args:
842 ''' Command: Case-sensitive. The command itself is not checked.
844 ''' If nothing happens, then the command is probably wrong
845 ''' Args: Pairs of arguments name (string), value (any)
846 ''' Returns:
847 ''' Examples:
848 ''' oDoc.RunCommand("EditDoc", "Editable", False) ' Toggle edit mode
850 Dim vArgs As Variant ' Alias of Args
851 Dim oDispatch ' com.sun.star.frame.DispatchHelper
852 Dim vProps As Variant ' Array of PropertyValues
853 Dim vValue As Variant ' A single value argument
854 Dim sCommand As String ' Alias of Command
855 Dim i As Long
861 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
863 Check:
864 ' When called from a subclass (Calc, Writer, ..) the arguments are gathered into one single array item
865 vArgs = Args
866 If IsArray(Args) Then
869 End If
870 End If
871 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
872 If Not _IsStillAlive() Then GoTo Finally
876 If Not ScriptForge.SF_Utils._Validate(vArgs(i), "Arg" & CStr(i/2) & "Name", V_STRING) Then GoTo Finally
877 Next i
878 End If
880 Try:
881 ' Build array of property values
882 vProps = Array()
885 vProps = ScriptForge.SF_Array.Append(vProps, ScriptForge.SF_Utils._MakePropertyValue(vArgs(i), vValue))
886 Next i
888 If ScriptForge.SF_String.StartsWith(Command, cstPrefix) Then sCommand = Command Else sCommand = cstPrefix & Command
891 Finally:
892 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
893 Exit Sub
894 Catch:
895 GoTo Finally
896 End Sub ' SFDocuments.SF_Document.RunCommand
898 REM -----------------------------------------------------------------------------
899 Public Function Save() As Boolean
900 ''' Store the document to the file location from which it was loaded
901 ''' Ignored if the document was not modified
902 ''' Args:
903 ''' Returns:
904 ''' False if the document could not be saved
905 ''' Exceptions:
906 ''' DOCUMENTSAVEERROR The file has been opened readonly or was opened as new and was not yet saved
907 ''' Examples:
908 ''' If Not oDoc.Save() Then
909 ''' ' ...
911 Dim bSaved As Boolean ' return value
913 Const cstSubArgs = ""
915 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
916 bSaved = False
918 Check:
919 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
920 If Not _IsStillAlive() Then GoTo Finally
921 bSaved = False
923 Try:
924 With _Component
925 If .isReadonly() Or Not .hasLocation() Then GoTo CatchReadonly
926 If .IsModified() Then
927 .store()
928 bSaved = True
929 End If
930 End With
932 Finally:
933 Save = bSaved
934 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
935 Exit Function
936 Catch:
937 GoTo Finally
938 CatchReadonly:
940 GoTo Finally
941 End Function ' SFDocuments.SF_Document.Save
943 REM -----------------------------------------------------------------------------
944 Public Function SaveAs(Optional ByVal FileName As Variant _
945 , Optional ByVal Overwrite As Variant _
946 , Optional ByVal Password As Variant _
947 , Optional ByVal FilterName As Variant _
948 , Optional ByVal FilterOptions As Variant _
949 ) As Boolean
950 ''' Store the document to the given file location
951 ''' The new location becomes the new file name on which simple Save method calls will be applied
952 ''' Args:
953 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
954 ''' Overwrite: True if the destination file may be overwritten (default = False)
955 ''' Password: Use to protect the document
956 ''' FilterName: the name of a filter that should be used for saving the document
957 ''' If present, the filter must exist
958 ''' FilterOptions: an optional string of options associated with the filter
959 ''' Returns:
960 ''' False if the document could not be saved
961 ''' Exceptions:
962 ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
963 ''' Examples:
966 Dim bSaved As Boolean ' return value
967 Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
968 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
969 Dim sFile As String ' Alias of FileName
970 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
971 Dim FSO As Object ' SF_FileSystem
973 Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]"
975 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
976 bSaved = False
978 Check:
979 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
980 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
981 If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = ""
982 If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = ""
984 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
985 If Not _IsStillAlive() Then GoTo Finally
987 If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
991 End If
993 ' Check that the filter exists
996 If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError
997 End If
999 ' Check destination file overwriting
1001 sFile = FSO._ConvertToUrl(FileName)
1002 If FSO.FileExists(FileName) Then
1003 If Overwrite = False Then GoTo CatchError
1005 If oSfa.isReadonly(sFile) Then GoTo CatchError
1006 End If
1008 Try:
1009 ' Setup arguments
1010 If Len(Password) + Len(FilterName) = 0 Then
1011 vProperties = Array()
1012 Else
1013 vProperties = Array( _
1016 )
1018 vProperties = ScriptForge.SF_Array.Append(vProperties _
1020 End If
1021 End If
1023 _Component.StoreAsURL(sFile, vProperties)
1025 ' Remind the new file name
1026 _WindowFileName = sFile
1027 _WindowName = FSO.GetName(FileName)
1028 bSaved = True
1030 Finally:
1031 SaveAs = bSaved
1032 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1033 Exit Function
1034 Catch:
1035 GoTo Finally
1036 CatchError:
1037 ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
1039 GoTo Finally
1040 End Function ' SFDocuments.SF_Document.SaveAs
1042 REM -----------------------------------------------------------------------------
1043 Public Function SaveCopyAs(Optional ByVal FileName As Variant _
1044 , Optional ByVal Overwrite As Variant _
1045 , Optional ByVal Password As Variant _
1046 , Optional ByVal FilterName As Variant _
1047 , Optional ByVal FilterOptions As Variant _
1048 ) As Boolean
1049 ''' Store a copy or export the document to the given file location
1050 ''' The actual location is unchanged
1051 ''' Args:
1052 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
1053 ''' Overwrite: True if the destination file may be overwritten (default = False)
1054 ''' Password: Use to protect the document
1055 ''' FilterName: the name of a filter that should be used for saving the document
1056 ''' If present, the filter must exist
1057 ''' FilterOptions: an optional string of options associated with the filter
1058 ''' Returns:
1059 ''' False if the document could not be saved
1060 ''' Exceptions:
1061 ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
1062 ''' Examples:
1065 Dim bSaved As Boolean ' return value
1066 Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
1067 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1068 Dim sFile As String ' Alias of FileName
1069 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
1070 Dim FSO As Object ' SF_FileSystem
1072 Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]"
1074 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
1075 bSaved = False
1077 Check:
1078 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
1079 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
1080 If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = ""
1081 If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = ""
1083 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1084 If Not _IsStillAlive() Then GoTo Finally
1086 If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
1089 If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally
1090 End If
1092 ' Check that the filter exists
1095 If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError
1096 End If
1098 ' Check destination file overwriting
1100 sFile = FSO._ConvertToUrl(FileName)
1101 If FSO.FileExists(FileName) Then
1102 If Overwrite = False Then GoTo CatchError
1104 If oSfa.isReadonly(sFile) Then GoTo CatchError
1105 End If
1107 Try:
1108 ' Setup arguments
1109 If Len(Password) + Len(FilterName) = 0 Then
1110 vProperties = Array()
1111 Else
1112 vProperties = Array( _
1115 )
1117 vProperties = ScriptForge.SF_Array.Append(vProperties _
1119 End If
1120 End If
1122 _Component.StoreToURL(sFile, vProperties)
1123 bSaved = True
1125 Finally:
1126 SaveCopyAs = bSaved
1127 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1128 Exit Function
1129 Catch:
1130 GoTo Finally
1131 CatchError:
1132 ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
1134 GoTo Finally
1135 End Function ' SFDocuments.SF_Document.SaveCopyAs
1137 REM -----------------------------------------------------------------------------
1138 Public Function SetPrinter(Optional ByVal Printer As Variant _
1139 , Optional ByVal Orientation As Variant _
1140 , Optional ByVal PaperFormat As Variant _
1141 , Optional ByRef _PrintComponent As Variant _
1142 ) As Boolean
1143 ''' Define the printer options for the document
1144 ''' Args:
1145 ''' Printer: the name of the printer queue where to print to
1146 ''' When absent or space, the default printer is set
1147 ''' Orientation: either "PORTRAIT" or "LANDSCAPE". Left unchanged when absent
1148 ''' PaperFormat: one of next values
1149 ''' "A3", "A4", "A5", "B4", "B5", "LETTER", "LEGAL", "TABLOID"
1150 ''' Left unchanged when absent
1151 ''' _PrintComponent: undocumented argument to determine the component
1152 ''' Useful typically to apply printer settings on a Base form document
1153 ''' Returns:
1154 ''' True when successful
1155 ''' Examples:
1158 Dim bPrinter As Boolean ' Return value
1159 Dim vPrinters As Variant ' Array of known printers
1160 Dim vOrientations As Variant ' Array of allowed paper orientations
1161 Dim vPaperFormats As Variant ' Array of allowed formats
1162 Dim vPrinterSettings As Variant ' Array of property values
1163 Dim oPropertyValue As New com.sun.star.beans.PropertyValue
1164 ' A single property value item
1166 Const cstSubArgs = "[Printer=""""], [Orientation=""PORTRAIT""|""LANDSCAPE""]" _
1167 & ", [PaperFormat=""A3""|""A4""|""A5""|""B4""|""B5""|""LETTER""|""LEGAL""|""TABLOID"""
1169 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1170 bPrinter = False
1172 Check:
1173 If IsMissing(Printer) Or IsEmpty(Printer) Then Printer = ""
1174 If IsMissing(Orientation) Or IsEmpty(Orientation) Then Orientation = ""
1175 If IsMissing(PaperFormat) Or IsEmpty(PaperFormat) Then PaperFormat = ""
1176 If IsMissing(_PrintComponent) Or IsEmpty(_PrintComponent) Then Set _PrintComponent = _Component
1178 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional validation
1179 If Not _IsStillAlive() Then GoTo Finally
1180 If VarType(Printer) = V_STRING Then
1181 vPrinters = ScriptForge.SF_Platform.Printers
1183 If Not ScriptForge.SF_Utils._Validate(Printer, "Printer", V_STRING, vPrinters) Then GoTo Finally
1184 End If
1185 Else
1186 If Not ScriptForge.SF_Utils._Validate(Printer, "Printer", V_STRING) Then GoTo Finally ' Manage here the VarType error
1187 End If
1188 If VarType(Orientation) = V_STRING Then
1191 If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, vOrientations) Then GoTo Finally
1192 End If
1193 Else
1194 If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING) Then GoTo Finally
1195 End If
1196 If VarType(PaperFormat) = V_STRING Then
1197 vPaperFormats = Array("A3", "A4", "A5", "B4", "B5", "LETTER", "LEGAL", "TABLOID")
1199 If Not ScriptForge.SF_Utils._Validate(PaperFormat, "PaperFormat", V_STRING, vPaperFormats) Then GoTo Finally
1200 End If
1201 Else
1202 If Not ScriptForge.SF_Utils._Validate(PaperFormat, "PaperFormat", V_STRING) Then GoTo Finally
1203 End If
1205 Try:
1206 With _PrintComponent
1207 Set oPropertyValue = ScriptForge.SF_Utils._MakePropertyValue("Name", Iif(Len(Printer) > 0, Printer, vPrinters(0)))
1208 vPrinterSettings = Array(oPropertyValue)
1210 vPrinterSettings = ScriptForge.SF_Utils._SetPropertyValue(vPrinterSettings, "PaperOrientation" _
1211 , ScriptForge.SF_Array.IndexOf(vOrientations, Orientation, CaseSensitive := False))
1212 End If
1214 vPrinterSettings = ScriptForge.SF_Utils._SetPropertyValue(vPrinterSettings, "PaperFormat" _
1215 , ScriptForge.SF_Array.IndexOf(vPaperFormats, PaperFormat, CaseSensitive := False))
1216 End If
1217 .setPrinter(vPrinterSettings)
1218 End With
1219 bPrinter = True
1221 Finally:
1222 SetPrinter = bPrinter
1223 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1224 Exit Function
1225 Catch:
1226 GoTo Finally
1227 End Function ' SFDocuments.SF_Document.SetPrinter
1229 REM -----------------------------------------------------------------------------
1230 Private Function SetProperty(Optional ByVal psProperty As String _
1231 , Optional ByVal pvValue As Variant _
1232 ) As Boolean
1233 ''' Set the new value of the named property
1234 ''' Args:
1235 ''' psProperty: the name of the property
1236 ''' pvValue: the new value of the given property
1237 ''' Returns:
1238 ''' True if successful
1240 Dim bSet As Boolean ' Return value
1241 Static oSession As Object ' Alias of SF_Session
1242 Dim cstThisSub As String
1245 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1246 bSet = False
1249 If IsMissing(pvValue) Then pvValue = Empty
1250 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets
1252 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1253 bSet = True
1254 Select Case UCase(psProperty)
1256 CustomProperties = pvValue
1258 Description = pvValue
1260 Keywords = pvValue
1262 Subject = pvValue
1264 Title = pvValue
1265 Case Else
1266 bSet = False
1267 End Select
1269 Finally:
1270 SetProperty = bSet
1271 'ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1272 Exit Function
1273 Catch:
1274 GoTo Finally
1275 End Function ' SFDocuments.SF_Document.SetProperty
1277 REM =========================================================== PRIVATE FUNCTIONS
1279 REM -----------------------------------------------------------------------------
1280 Private Function _FileIdent() As String
1281 ''' Returns a file identification from the information that is currently available
1282 ''' Useful e.g. for display in error messages
1284 ' OS notation is used to avoid presence of "%nn" in error messages and wrong parameter substitutions
1287 End Function ' SFDocuments.SF_Document._FileIdent
1289 REM -----------------------------------------------------------------------------
1290 Private Function _GetFilterNames(ByVal pbExport As Boolean) As Variant
1291 ''' Returns the list of export (pbExport = True) or import filters
1292 ''' applicable to the current document
1293 ''' Args:
1294 ''' pbExport: True for export, False for import
1295 ''' Returns:
1296 ''' A zero-based array of strings
1298 Dim vFilters As Variant ' Return value
1299 Dim sIdentifier As String ' Document service, like com.sun.star.text.TextDocument
1300 Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
1301 Dim vAllFilters As Variant ' The full list of installed filters
1302 Dim sFilter As String ' A single filter name
1303 Dim iCount As Integer ' Filters counter
1304 Dim vFilter As Variant ' A filter descriptor as an array of Name/Value pairs
1305 Dim sType As String ' The filter type to be compared with the document service
1306 Dim lFlags As Long ' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Office_Development#Properties_of_a_Filter
1307 Dim bExport As Boolean ' Filter valid for export when True
1308 Dim bImport As Boolean ' Filter valid for import when True
1309 Dim bImportExport As Boolean ' Filter valid both for import and export when True
1311 vFilters = Array()
1312 On Local Error GoTo Finally ' Return empty or partial list if error
1314 Try:
1315 sIdentifier = _Component.Identifier
1317 vAllFilters = oFilterFactory.getElementNames()
1318 ReDim vFilters(0 To UBound(vAllFilters))
1319 iCount = -1
1321 For Each sFilter In vAllFilters
1322 vFilter = oFilterFactory.getByName(sFilter)
1324 If sType = sIdentifier Then
1326 ' export: flag is even
1332 ' Select filter ?
1333 If bImportExport _
1334 Or (pbExport And bExport) _
1335 Or (Not pbExport And bImport) Then
1336 iCount = iCount + 1
1337 vFilters(iCount) = sFilter
1338 End If
1339 End If
1340 Next sFilter
1343 ReDim Preserve vFilters(0 To iCount)
1344 End If
1346 Finally:
1347 _GetFilterNames = vFilters
1348 Exit Function
1349 End Function ' SFDocuments.SF_Document._GetFilterNames
1351 REM -----------------------------------------------------------------------------
1352 Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _
1353 , Optional ByVal pbError As Boolean _
1354 ) As Boolean
1355 ''' Returns True if the document has not been closed manually or incidentally since the last use
1356 ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
1357 ''' Args:
1358 ''' pbForUpdate: if True (default = False), check additionally if document is open for editing
1359 ''' pbError: if True (default), raise a fatal error
1361 Dim bAlive As Boolean ' Return value
1362 Dim sFileName As String ' File identification used to display error message
1364 On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
1365 If IsMissing(pbForUpdate) Then pbForUpdate = False
1366 If IsMissing(pbError) Then pbError = True
1368 Try:
1369 ' Check existence of document
1370 bAlive = Not IsNull(_Frame)
1371 If bAlive Then bAlive = Not IsNull(_Component)
1372 If bAlive Then bAlive = Not IsNull(_Component.CurrentController)
1374 ' Check document is not read only
1375 If bAlive And pbForUpdate Then
1376 If _Component.isreadonly() Then GoTo CatchReadonly
1377 End If
1379 Finally:
1380 _IsStillAlive = bAlive
1381 Exit Function
1382 Catch:
1383 bAlive = False
1384 On Error GoTo 0
1385 sFileName = _FileIdent()
1386 Dispose()
1387 If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sFileName)
1388 GoTo Finally
1389 CatchReadonly:
1390 bAlive = False
1391 If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTREADONLYERROR, "Document", _FileIdent())
1392 GoTo Finally
1393 End Function ' SFDocuments.SF_Document._IsStillAlive
1395 REM -----------------------------------------------------------------------------
1396 Private Sub _LoadDocumentProperties()
1397 ''' Create dictionary with document properties as entries/ Custom properties are excluded
1398 ''' Document is presumed still alive
1399 ''' Special values:
1400 ''' Only valid dates are taken
1401 ''' Statistics are exploded in subitems. Subitems are specific to document type
1402 ''' Keywords are joined
1403 ''' Language is aligned on L10N convention la-CO
1405 Dim oProperties As Object ' Document properties
1406 Dim vNamedValue As Variant ' com.sun.star.beans.NamedValue
1408 If IsNull(_DocumentProperties) Then
1409 Set oProperties = _Component.getDocumentProperties
1411 With _DocumentProperties
1415 If oProperties.CreationDate.Year > 0 Then .Add("CreationDate", CDateFromUnoDateTime(oProperties.CreationDate))
1418 ' DocumentStatistics : number and names of statistics depend on document type
1419 For Each vNamedValue In oProperties.DocumentStatistics
1420 .Add(vNamedValue.Name, vNamedValue.Value)
1421 Next vNamedValue
1425 .Add("Language", oProperties.Language.Language & Iif(Len(oProperties.Language.Country) > 0, "-" & oProperties.Language.Country, ""))
1426 If oProperties.ModificationDate.Year > 0 Then .Add("ModificationDate", CDateFromUnoDateTime(oProperties.ModificationDate))
1427 If oProperties.PrintDate.Year > 0 Then .Add("PrintDate", CDateFromUnoDateTime(oProperties.PrintDate))
1430 If oProperties.TemplateDate.Year > 0 Then .Add("TemplateDate", CDateFromUnoDateTime(oProperties.TemplateDate))
1434 End With
1435 End If
1437 End Sub ' SFDocuments.SF_Document._LoadDocumentProperties
1439 REM -----------------------------------------------------------------------------
1440 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
1441 ''' Return the value of the named property
1442 ''' Args:
1443 ''' psProperty: the name of the property
1445 Dim oProperties As Object ' Document or Custom properties
1446 Dim cstThisSub As String
1447 Const cstSubArgs = ""
1449 _PropertyGet = False
1451 Select Case _DocumentType
1452 Case "Calc" : cstThisSub = "SFDocuments.SF_" & _DocumentType & ".get" & psProperty
1454 End Select
1455 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1456 If Not _IsStillAlive() Then GoTo Finally
1458 Select Case psProperty
1460 _CustomProperties = CreateScriptService("Dictionary") ' Always reload as updates could have been done manually by user
1461 _CustomProperties.ImportFromPropertyValues(_Component.getDocumentProperties().UserDefinedProperties.getPropertyValues)
1462 _PropertyGet = _CustomProperties
1464 _PropertyGet = _Component.DocumentProperties.Description
1466 _LoadDocumentProperties() ' Always reload as updates could have been done manually by user
1467 Set _PropertyGet = _DocumentProperties
1469 _PropertyGet = _DocumentType
1471 _PropertyGet = _GetFilterNames(True)
1473 _PropertyGet = _GetFilterNames(False)
1474 Case "IsBase", "IsCalc", "IsDraw", "IsImpress", "IsMath", "IsWriter"
1475 _PropertyGet = ( Mid(psProperty, 3) = _DocumentType )
1479 _PropertyGet = _Component.isReadonly()
1481 _PropertyGet = _Component.DocumentProperties.Subject
1483 _PropertyGet = _Component.DocumentProperties.Title
1485 Set _PropertyGet = _Component
1486 Case Else
1487 _PropertyGet = Null
1488 End Select
1490 Finally:
1491 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1492 Exit Function
1493 End Function ' SFDocuments.SF_Document._PropertyGet
1495 REM -----------------------------------------------------------------------------
1496 Private Function _Repr() As String
1497 ''' Convert the SF_Document instance to a readable string, typically for debugging purposes (DebugPrint ...)
1498 ''' Args:
1499 ''' Return:
1504 End Function ' SFDocuments.SF_Document._Repr
1506 REM ============================================ END OF SFDOCUMENTS.SF_DOCUMENT
1507 </script:module>