| blob | 0ad019315a5f4012cd4fdf3a93eb4d10aa090013 |
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
65 REM ============================================================= PRIVATE MEMBERS
67 Private [Me] As Object
68 Private [_Parent] As Object
69 Private [_SubClass] As Object ' Subclass instance
70 Private ObjectType As String ' Must be DOCUMENT
71 Private ServiceName As String
73 ' Window description
74 Private _Component As Object ' com.sun.star.lang.XComponent
75 Private _Frame As Object ' com.sun.star.comp.framework.Frame
76 Private _WindowName As String ' Object Name
77 Private _WindowTitle As String ' Only mean to identify new documents
78 Private _WindowFileName As String ' URL of file name
79 Private _DocumentType As String ' Writer, Calc, ...
80 Private _DocumentSettings As Object ' com.sun.star.XXX.DocumentSettings (XXX = sheet, text, drawing or presentation)
82 ' Properties (work variables - real properties could have been set manually by user)
83 Private _DocumentProperties As Object ' Dictionary of document properties
84 Private _CustomProperties As Object ' Dictionary of custom properties
86 ' Cache for static toolbar descriptions
87 Private _Toolbars As Object ' SF_Dictionary instance to hold toolbars stored in application or in document
89 ' List of standard context menus
90 Private _ContextMenus As Variant ' Array of ResourceURL strings
92 ' Style descriptor
93 Type StyleDescriptor
94 Family As Object
95 StyleName As String
96 DisplayName As String
97 IsUsed As Boolean
98 BuiltIn As Boolean
99 Category As String
100 ParentStyle As String
101 XStyle As Object
102 End Type
104 Private _StyleFamilies As Variant ' Array of available style families
106 REM ============================================================ MODULE CONSTANTS
110 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
112 REM -----------------------------------------------------------------------------
113 Private Sub Class_Initialize()
114 Set [Me] = Nothing
115 Set [_Parent] = Nothing
116 Set [_SubClass] = Nothing
119 Set _Component = Nothing
120 Set _Frame = Nothing
121 _WindowName = ""
122 _WindowTitle = ""
123 _WindowFileName = ""
124 _DocumentType = ""
125 Set _DocumentSettings = Nothing
126 Set _DocumentProperties = Nothing
127 Set _CustomProperties = Nothing
128 Set _Toolbars = Nothing
129 _ContextMenus = Array()
130 _StyleFamilies = Array()
131 End Sub ' SFDocuments.SF_Document Constructor
133 REM -----------------------------------------------------------------------------
134 Private Sub Class_Terminate()
135 Call Class_Initialize()
136 End Sub ' SFDocuments.SF_Document Destructor
138 REM -----------------------------------------------------------------------------
139 Public Function Dispose() As Variant
140 Call Class_Terminate()
141 Set Dispose = Nothing
142 End Function ' SFDocuments.SF_Document Explicit Destructor
144 REM ================================================================== PROPERTIES
146 REM -----------------------------------------------------------------------------
147 Property Get CustomProperties() As Variant
148 ''' Returns a dictionary of all custom properties of the document
150 End Property ' SFDocuments.SF_Document.CustomProperties
152 REM -----------------------------------------------------------------------------
153 Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant)
154 ''' Sets the updatable custom properties
155 ''' The argument is a dictionary
157 Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue
158 Dim vCustomProperties As Variant ' Alias of argument
159 Dim oUserdefinedProperties As Object ' Custom properties object
160 Dim vOldPropertyValues As Variant ' Array of (to remove) existing user defined properties
161 Dim oProperty As Object ' Single com.sun.star.beans.PropertyValues
162 Dim sProperty As String ' Property name
163 Dim vKeys As Variant ' Array of dictionary keys
164 Dim vItems As Variant ' Array of dictionary items
165 Dim vValue As Variant ' Value to store in property
166 Dim iAttribute As Integer ' com.sun.star.beans.PropertyAttribute.REMOVEABLE
167 Dim i As Long
171 On Local Error GoTo Catch
173 Check:
174 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
175 If Not _IsStillAlive(True) Then GoTo Finally
176 If Not ScriptForge.SF_Utils._Validate(pvCustomProperties, "CustomProperties", ScriptForge.V_OBJECT, , , "DICTIONARY") Then GoTo Finally
177 End If
179 Try:
180 Set oUserDefinedProperties = _Component.getDocumentProperties().UserDefinedProperties
182 Set vCustomProperties = pvCustomProperties ' To avoid "Object variable not set" error
183 With vCustomProperties
185 ' All existing custom properties must first be removed to avoid type conflicts
186 vOldPropertyValues = oUserDefinedProperties.getPropertyValues
187 For Each oProperty In vOldPropertyValues
188 sProperty = oProperty.Name
189 oUserDefinedProperties.removeProperty(sProperty)
190 Next oProperty
192 ' Insert new properties one by one after type adjustment (dates, arrays, numbers)
193 vKeys = .Keys
194 vItems = .Items
195 iAttribute = com.sun.star.beans.PropertyAttribute.REMOVEABLE
196 For i = 0 To UBound(vKeys)
197 If VarType(vItems(i)) = V_DATE Then
198 vValue = ScriptForge.SF_Utils._CDateToUnoDate(vItems(i))
199 ElseIf IsArray(vItems(i)) Then
200 vValue = Null
201 ElseIf ScriptForge.SF_Utils._VarTypeExt(vItems(i)) = ScriptForge.V_NUMERIC Then
203 Else
204 vValue = vItems(i)
205 End If
206 oUserDefinedProperties.addProperty(vKeys(i), iAttribute, vValue)
207 Next i
209 ' Declare the document as changed
210 _Component.setModified(True)
211 End With
213 ' Reload custom properties in current object instance
216 Finally:
217 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
218 Exit Property
219 Catch:
220 GoTo Finally
221 End Property ' SFDocuments.SF_Document.CustomProperties
223 REM -----------------------------------------------------------------------------
224 Property Get Description() As Variant
225 ''' Returns the updatable document property Description
227 End Property ' SFDocuments.SF_Document.Description
229 REM -----------------------------------------------------------------------------
230 Property Let Description(Optional ByVal pvDescription As Variant)
231 ''' Sets the updatable document property Description
232 ''' If multilined, separate lines by "\n" escape sequence or by hard breaks
234 Dim sDescription As String ' Alias of pvDescription
238 Check:
239 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
240 If Not _IsStillAlive(True) Then GoTo Finally
241 If Not ScriptForge.SF_Utils._Validate(pvDescription, "Description", V_STRING) Then GoTo Finally
242 End If
244 Try:
245 ' Update in UNO component object and in current instance
247 _Component.DocumentProperties.Description = sDescription
248 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Description", sdescription)
250 Finally:
251 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
252 Exit Property
253 End Property ' SFDocuments.SF_Document.Description
255 REM -----------------------------------------------------------------------------
256 Property Get DocumentProperties() As Variant
257 ''' Returns a dictionary of all standard document properties, custom properties are excluded
259 End Property ' SFDocuments.SF_Document.DocumentProperties
261 REM -----------------------------------------------------------------------------
262 Property Get DocumentType() As String
263 ''' Returns "Base", "Calc", "Draw", ... or "Writer"
265 End Property ' SFDocuments.SF_Document.DocumentType
267 REM -----------------------------------------------------------------------------
268 Property Get ExportFilters() As Variant
269 ''' Returns the list of the export filter names applicable to the current document
270 ''' as a zero-based array of strings
271 ''' Import/Export filters are included
273 End Property ' SFDocuments.SF_Document.ExportFilters
275 REM -----------------------------------------------------------------------------
276 Property Get FileSystem() As String
278 ''' The "FileSystem" service may be used to explore it, as long as the document remains open
279 ''' The property is not applicable to Base documents
280 ''' Example:
281 ''' Dim sRoot As String, FSO
282 ''' sRoot = oDoc.FileSystem
286 End Property ' SFDocuments.SF_Document.FileSystem
288 REM -----------------------------------------------------------------------------
289 Property Get ImportFilters() As Variant
290 ''' Returns the list of the import filter names applicable to the current document
291 ''' as a zero-based array of strings
292 ''' Import/Export filters are included
294 End Property ' SFDocuments.SF_Document.ImportFilters
296 REM -----------------------------------------------------------------------------
297 Property Get IsAlive() As Boolean
299 End Property ' SFDocuments.SF_Document.IsAlive
301 REM -----------------------------------------------------------------------------
302 Property Get IsBase() As Boolean
304 End Property ' SFDocuments.SF_Document.IsBase
306 REM -----------------------------------------------------------------------------
307 Property Get IsCalc() As Boolean
309 End Property ' SFDocuments.SF_Document.IsCalc
311 REM -----------------------------------------------------------------------------
312 Property Get IsDraw() As Boolean
314 End Property ' SFDocuments.SF_Document.IsDraw
316 REM -----------------------------------------------------------------------------
317 Property Get IsFormDocument() As Boolean
319 End Property ' SFDocuments.SF_Document.IsFormDocument
321 REM -----------------------------------------------------------------------------
322 Property Get IsImpress() As Boolean
324 End Property ' SFDocuments.SF_Document.IsImpress
326 REM -----------------------------------------------------------------------------
327 Property Get IsMath() As Boolean
329 End Property ' SFDocuments.SF_Document.IsMath
331 REM -----------------------------------------------------------------------------
332 Property Get IsWriter() As Boolean
334 End Property ' SFDocuments.SF_Document.IsWriter
336 REM -----------------------------------------------------------------------------
337 Property Get Keywords() As Variant
338 ''' Returns the updatable document property Keywords
340 End Property ' SFDocuments.SF_Document.Keywords
342 REM -----------------------------------------------------------------------------
343 Property Let Keywords(Optional ByVal pvKeywords As Variant)
344 ''' Sets the updatable document property Keywords
346 Dim vKeywords As Variant ' Alias of pvKeywords
350 Check:
351 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
352 If Not _IsStillAlive(True) Then GoTo Finally
353 If Not ScriptForge.SF_Utils._Validate(pvKeywords, "Keywords", V_STRING) Then GoTo Finally
354 End If
356 Try:
357 ' Update in UNO component object and in current instance
359 _Component.DocumentProperties.Keywords = vKeywords
360 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Keywords", Join(vKeywords, ", "))
362 Finally:
363 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
364 Exit Property
365 End Property ' SFDocuments.SF_Document.Keywords
367 REM -----------------------------------------------------------------------------
368 Property Get Readonly() As Boolean
369 ''' Returns True if the document must not be modified
371 End Property ' SFDocuments.SF_Document.Readonly
373 REM -----------------------------------------------------------------------------
374 Property Get StyleFamilies() As Variant
375 ''' Returns the list of available style families, as an array of strings
377 End Property ' SFDocuments.SF_Document.StyleFamilies
379 REM -----------------------------------------------------------------------------
380 Property Get Subject() As Variant
381 ''' Returns the updatable document property Subject
383 End Property ' SFDocuments.SF_Document.Subject
385 REM -----------------------------------------------------------------------------
386 Property Let Subject(Optional ByVal pvSubject As Variant)
387 ''' Sets the updatable document property Subject
392 Check:
393 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
394 If Not _IsStillAlive(True) Then GoTo Finally
395 If Not ScriptForge.SF_Utils._Validate(pvSubject, "Subject", V_STRING) Then GoTo Finally
396 End If
398 Try:
399 ' Update in UNO component object and in current instance
400 _Component.DocumentProperties.Subject = pvSubject
401 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Subject", pvSubject)
403 Finally:
404 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
405 Exit Property
406 End Property ' SFDocuments.SF_Document.Subject
408 REM -----------------------------------------------------------------------------
409 Property Get Title() As Variant
410 ''' Returns the updatable document property Title
412 End Property ' SFDocuments.SF_Document.Title
414 REM -----------------------------------------------------------------------------
415 Property Let Title(Optional ByVal pvTitle As Variant)
416 ''' Sets the updatable document property Title
421 Check:
422 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
423 If Not _IsStillAlive(True) Then GoTo Finally
425 End If
427 Try:
428 ' Update in UNO component object and in current instance
429 _Component.DocumentProperties.Title = pvTitle
430 If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Title", pvTitle)
432 Finally:
433 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
434 Exit Property
435 End Property ' SFDocuments.SF_Document.Title
437 REM -----------------------------------------------------------------------------
438 Property Get XComponent() As Variant
439 ''' Returns the com.sun.star.lang.XComponent UNO object representing the document
441 End Property ' SFDocuments.SF_Document.XComponent
443 REM -----------------------------------------------------------------------------
444 Property Get XDocumentSettings() As Variant
445 ''' Gives access to a bunch of additional properties, specific to the document's type, about the document
446 ''' Returns Nothing or a com.sun.star.XXX.DocumentSettings, XXX = text, sheet, drawing or presentation.
448 End Property ' SFDocuments.SF_Document.XDocumentSettings
450 REM ===================================================================== METHODS
452 REM -----------------------------------------------------------------------------
453 Public Function Activate() As Boolean
454 ''' Make the current document active
455 ''' Args:
456 ''' Returns:
457 ''' True if the document could be activated
458 ''' Otherwise, there is no change in the actual user interface
459 ''' Examples:
460 ''' oDoc.Activate()
462 Dim bActivate As Boolean ' Return value
463 Dim oContainer As Object ' com.sun.star.awt.XWindow
465 Const cstSubArgs = ""
467 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
468 bActivate = False
470 Check:
471 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
472 If Not _IsStillAlive() Then GoTo Finally
474 Try:
475 Set oContainer = _Frame.ContainerWindow
476 With oContainer
477 If .isVisible() = False Then .setVisible(True)
478 If .IsMinimized Then .IsMinimized = False
479 .setFocus()
480 .toFront() ' Force window change in Linux
482 End With
483 bActivate = True
485 Finally:
486 Activate = bActivate
487 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
488 Exit Function
489 Catch:
490 GoTo Finally
491 End Function ' SFDocuments.SF_Document.Activate
493 REM -----------------------------------------------------------------------------
494 Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean
495 ''' Close the document. Does nothing if the document is already closed
496 ''' regardless of how the document was closed, manually or by program
497 ''' Args:
498 ''' SaveAsk: If True (default), the user is invited to confirm or not the writing of the changes on disk
499 ''' No effect if the document was not modified
500 ''' Returns:
501 ''' False if the user declined to close
502 ''' Examples:
503 ''' If oDoc.CloseDocument() Then
504 ''' ' ...
506 Dim bClosed As Boolean ' return value
507 Dim oDispatch ' com.sun.star.frame.DispatchHelper
511 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
512 bClosed = False
514 Check:
515 If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True
516 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
517 If Not _IsStillAlive() Then GoTo Finally
518 If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", ScriptForge.V_BOOLEAN) Then GoTo Finally
519 End If
521 Try:
522 If SaveAsk And _Component.IsModified Then ' Execute closure with the File/Close menu command
523 Activate()
525 bClosed = Not _IsStillAlive(, False) ' Do not raise error
526 Else
527 _Frame.close(True)
528 _Frame.dispose()
529 bClosed = True
530 End If
532 Finally:
533 If bClosed Then Dispose()
534 CloseDocument = bClosed
535 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
536 Exit Function
537 Catch:
538 On Local Error GoTo 0
539 GoTo Finally
540 End Function ' SFDocuments.SF_Document.CloseDocument
542 REM -----------------------------------------------------------------------------
543 Public Function ContextMenus(Optional ByVal ContextMenuName As Variant _
544 , Optional ByVal SubmenuChar As Variant _
545 ) As Variant
546 ''' Returns either a list of the available ContextMenu names in the actual document
547 ''' or a SFWidgets.ContextMenu object instance.
548 ''' Args:
549 ''' ContextMenuName: the usual name of one of the available ContextMenus
550 ''' SubmenuChar: Delimiter used in menu trees
551 ''' Returns:
552 ''' A zero-based array of ContextMenu names when there is no argument,
553 ''' or a new ContextMenu object instance from the SFWidgets library.
556 Const cstSubArgs = "[ContextMenuName=""""], [SubmenuChar="">""]"
558 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
560 Check:
561 If IsMissing(ContextMenuName) Or IsEmpty(ContextMenuName) Then ContextMenuName = ""
562 If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = ">"
564 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
565 If Not _IsStillAlive() Then GoTo Finally
566 If VarType(ContextMenuName) = V_STRING Then
568 If Not ScriptForge.SF_Utils._Validate(ContextMenuName, "ContextMenuName", V_STRING, _ContextMenus) Then GoTo Finally
569 End If
570 Else
571 If Not ScriptForge.SF_Utils._Validate(ContextMenuName, "ContextMenuName", V_STRING) Then GoTo Finally ' Manage here the VarType error
572 End If
573 If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
574 End If
576 Try:
577 If Len(ContextMenuName) = 0 Then
578 ContextMenus = _ContextMenus
579 Else
581 , _Component _
583 , SubmenuChar)
584 End If
586 Finally:
587 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
588 Exit Function
589 Catch:
590 GoTo Finally
591 End Function ' SFDocuments.SF_Document.ContextMenus
593 REM -----------------------------------------------------------------------------
594 Public Function CreateMenu(Optional ByVal MenuHeader As Variant _
595 , Optional ByVal Before As Variant _
596 , Optional ByVal SubmenuChar As Variant _
597 , Optional ByRef _Document As Variant _
598 ) As Object
600 ''' The menu is not intended to be saved neither in the LibreOffice global environment, nor in the document
601 ''' The method returns a SFWidgets.Menu instance. Its methods let define the menu further.
602 ''' Args:
603 ''' MenuHeader: the name/header of the menu
604 ''' Before: the place where to put the new menu on the menubar (string or number >= 1)
607 ''' _Document: undocumented argument to designate the document where the menu will be located
608 ''' Returns:
609 ''' A SFWidgets.Menu instance or Nothing
610 ''' Examples:
611 ''' Dim oMenu As Object
612 ''' Set oMenu = oDoc.CreateMenu("My menu", Before := "Styles")
613 ''' With oMenu
615 ''' '...
616 ''' .Dispose() ' When definition is complete, the menu instance may be disposed
617 ''' End With
618 ''' ' ...
620 Dim oMenu As Object ' return value
622 Const cstSubArgs = "MenuHeader, [Before=""""], [SubmenuChar="">""]"
624 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
625 Set oMenu = Nothing
627 Check:
628 If IsMissing(Before) Or IsEmpty(Before) Then Before = ""
629 If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = ""
630 If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component
632 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
633 If Not _IsStillAlive() Then GoTo Finally
634 If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
635 If Not ScriptForge.SF_Utils._Validate(Before, "Before", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
636 If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
637 End If
639 Try:
640 Set oMenu = ScriptForge.SF_Services.CreateScriptService("SFWidgets.Menu", _Document, MenuHeader, Before, SubmenuChar)
642 Finally:
643 Set CreateMenu = oMenu
644 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
645 Exit Function
646 Catch:
647 GoTo Finally
648 End Function ' SFDocuments.SF_Document.CreateMenu
650 REM -----------------------------------------------------------------------------
651 Public Sub DeleteStyles(Optional ByVal Family As Variant _
652 , Optional ByRef StylesList As Variant _
653 )
654 ''' Delete a single style or an array of styles given by their name(s)
655 ''' within a specific styles family.
656 ''' Only user-defined styles may be deleted. Built-in styles are ignored.
657 ''' Args:
658 ''' Family: one of the style families present in the actual document, as a case-sensitive string
659 ''' StylesList: a single style name as a string or an array of style names.
660 ''' The style names may be localized or not.
661 ''' The StylesList is typically the output of the execution of a Styles() method.
662 ''' Returns:
663 ''' Examples:
664 ''' ' Remove all unused styles
666 ''' doc.DeleteStyles(family, doc.Styles(family, Used := False, UserDefined := True))
668 Dim oFamily As Object ' Style names container
669 Dim vStylesList As Variant ' Alias of StylesList
670 Dim sStyle As String ' A single style name
674 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
676 Check:
677 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
678 If Not _IsStillAlive() Then GoTo Finally
679 If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames()
680 If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally
681 If IsArray(StylesList) Then
682 If Not ScriptForge.SF_Utils._ValidateArray(StylesList, "StylesList", 1, V_STRING, True) Then GoTo Finally
683 Else
684 If Not ScriptForge.SF_Utils._Validate(StylesList, "StylesList", V_STRING) Then GoTo Finally
685 End If
686 End If
688 Try:
689 Set oFamily = _GetStyleFamily(Family)
690 If Not IsNull(oFamily) Then
691 With oFamily
692 If Not IsArray(StylesList) Then vStylesList = Array(StylesList) Else vStylesList = StylesList
693 For Each sStyle In vStylesList
694 If .hasByName(sStyle) Then .removeByName(sStyle)
695 Next sStyle
696 End With
697 End If
699 Finally:
700 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
701 Exit Sub
702 Catch:
703 GoTo Finally
704 End Sub ' SFDocuments.SF_Document.DeleteStyles
706 REM -----------------------------------------------------------------------------
707 Public Sub Echo(Optional ByVal EchoOn As Variant _
708 , Optional ByVal Hourglass As Variant _
709 )
710 ''' While a script is executed any display update resulting from that execution
711 ''' is done immediately.
712 ''' For performance reasons it might be an advantage to differ the display updates
713 ''' up to the end of the script.
714 ''' This is where pairs of Echo() methods to set and reset the removal of the
715 ''' immediate updates may be beneficial.
716 ''' Optionally the actual mouse pointer can be modified to the image of an hourglass.
717 ''' Args:
718 ''' EchoOn: when False, the display updates are suspended. Default = True.
719 ''' Multiple calls with EchoOn = False are harmless.
720 ''' Hourglass: when True, the mouse pointer is changed to an hourglass. Default = False.
722 ''' Note that it is very likely that at the least manual movement of the mouse,
723 ''' the operating system or the LibreOffice process will take back the control
724 ''' of the mouse icon and its usual behaviour.
725 ''' Returns:
726 ''' Examples:
727 ''' oDoc.Echo(False, Hourglass := True)
731 Dim oContainer As Object ' com.sun.star.awt.XWindow
732 Dim lPointer As Long ' com.sun.star.awt.SystemPointer constant
733 Dim oPointer As Object ' com.sun.star.awt.Pointer
737 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
739 Check:
740 If IsMissing(EchoOn) Or IsEmpty(EchoOn) Then EchoOn = True
741 If IsMissing(Hourglass) Or IsEmpty(Hourglass) Then Hourglass = False
742 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
743 If Not _IsStillAlive() Then GoTo Finally
745 If Not SF_Utils._Validate(Hourglass, "Hourglass", ScriptForge.V_BOOLEAN) Then GoTo Finally
746 End If
748 Try:
749 With _Component
751 Set oContainer = .CurrentController.Frame.GetContainerWindow()
753 With com.sun.star.awt.SystemPointer
754 If Hourglass Then lPointer = .WAIT Else lPointer = .ARROW
755 End With
756 oPointer.setType(lPointer)
758 ' Mouse icon is set when controller is unlocked
759 If Not EchoOn Then
760 oContainer.setPointer(oPointer)
761 .lockControllers()
762 Else ' EchoOn = True
763 Do While .hasControllersLocked()
764 .unlockControllers()
765 Loop
766 oContainer.setPointer(oPointer)
767 End If
769 End With
771 Finally:
772 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
773 Exit Sub
774 Catch:
775 GoTo Finally
776 End Sub ' SFDocuments.SF_Document.Echo
778 REM -----------------------------------------------------------------------------
779 Public Function ExportAsPDF(Optional ByVal FileName As Variant _
780 , Optional ByVal Overwrite As Variant _
781 , Optional ByVal Pages As Variant _
782 , Optional ByVal Password As Variant _
783 , Optional ByVal Watermark As Variant _
784 ) As Boolean
785 ''' Store the document to the given file location in PDF format
786 ''' Args:
787 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
788 ''' Overwrite: True if the destination file may be overwritten (default = False)
789 ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
790 ''' Password: password to open the document
791 ''' Watermark: the text for a watermark to be drawn on every page of the exported PDF file
792 ''' Returns:
793 ''' False if the document could not be saved
794 ''' Exceptions:
795 ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
796 ''' Examples:
799 Dim bSaved As Boolean ' return value
800 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
801 Dim sFile As String ' Alias of FileName
802 Dim sFilter As String ' One of the pdf filter names
803 Dim vFilterData As Variant ' Array of com.sun.star.beans.PropertyValue
804 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
805 Dim FSO As Object ' SF_FileSystem
807 Const cstSubArgs = "FileName, [Overwrite=False], [Pages=""""], [Password=""""], [Watermark=""""]"
809 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
810 bSaved = False
812 Check:
813 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
814 If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
815 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
816 If IsMissing(Watermark) Or IsEmpty(Watermark) Then Watermark = ""
818 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
819 If Not _IsStillAlive() Then GoTo Finally
821 If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
825 End If
827 ' Check destination file overwriting
829 sFile = FSO._ConvertToUrl(FileName)
830 If FSO.FileExists(FileName) Then
831 If Overwrite = False Then GoTo CatchError
833 If oSfa.isReadonly(sFile) Then GoTo CatchError
834 End If
836 Try:
837 ' Setup arguments
838 Select Case _DocumentType ' Disguise form documents as a Writer document
841 End Select
842 ' FilterData parameters are added only if they are meaningful
843 vFilterData = Array()
845 vFilterData = ScriptForge.SF_Array.Append(vFilterData _
847 End If
849 vFilterData = ScriptForge.SF_Array.Append(vFilterData _
852 End If
854 vFilterData = ScriptForge.SF_Array.Append(vFilterData _
856 End If
858 ' Finalize properties and export
859 vProperties = Array( _
862 _Component.StoreToURL(sFile, vProperties)
863 bSaved = True
865 Finally:
866 ExportAsPDF = bSaved
867 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
868 Exit Function
869 Catch:
870 GoTo Finally
871 CatchError:
872 ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
874 GoTo Finally
875 End Function ' SFDocuments.SF_Document.ExportAsPDF
877 REM -----------------------------------------------------------------------------
878 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
879 ''' Return the actual value of the given property
880 ''' Args:
881 ''' PropertyName: the name of the property as a string
882 ''' Returns:
883 ''' The actual value of the property
884 ''' If the property does not exist, returns Null
885 ''' Exceptions:
886 ''' see the exceptions of the individual properties
887 ''' Examples:
891 Const cstSubArgs = ""
893 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
894 GetProperty = Null
896 Check:
897 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
898 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
899 End If
901 Try:
902 GetProperty = _PropertyGet(PropertyName)
904 Finally:
905 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
906 Exit Function
907 Catch:
908 GoTo Finally
909 End Function ' SFDocuments.SF_Document.GetProperty
911 REM -----------------------------------------------------------------------------
912 Public Function Methods() As Variant
913 ''' Return the list of public methods of the Document service as an array
915 Methods = Array( _
934 )
936 End Function ' SFDocuments.SF_Document.Methods
938 REM -----------------------------------------------------------------------------
939 Public Function PrintOut(Optional ByVal Pages As Variant _
940 , Optional ByVal Copies As Variant _
941 , Optional ByRef _Document As Variant _
942 ) As Boolean
943 ''' Send the content of the document to the printer.
944 ''' The printer might be defined previously by default, by the user or by the SetPrinter() method
945 ''' Args:
946 ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
947 ''' Copies: the number of copies
948 ''' _Document: undocumented argument to designate the document to print when called from a subclass
949 ''' Returns:
950 ''' True when successful
951 ''' Examples:
954 Dim bPrint As Boolean ' Return value
955 Dim vPrintGoal As Variant ' Array of property values
960 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
961 bPrint = False
963 Check:
964 If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
965 If IsMissing(Copies) Or IsEmpty(Copies) Then Copies = 1
966 If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component
968 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
969 If Not _IsStillAlive() Then GoTo Finally
971 If Not ScriptForge.SF_Utils._Validate(Copies, "Copies", ScriptForge.V_NUMERIC) Then GoTo Finally
972 End If
974 Try:
975 vPrintGoal = Array( _
980 )
982 _Document.Print(vPrintGoal)
983 bPrint = True
985 Finally:
986 PrintOut = bPrint
987 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
988 Exit Function
989 Catch:
990 GoTo Finally
991 End Function ' SFDocuments.SF_Document.PrintOut
993 REM -----------------------------------------------------------------------------
994 Public Function Properties() As Variant
995 ''' Return the list or properties of the Document class as an array
997 Properties = Array( _
1020 )
1022 End Function ' SFDocuments.SF_Document.Properties
1024 REM -----------------------------------------------------------------------------
1025 Public Function RemoveMenu(Optional ByVal MenuHeader As Variant _
1026 , Optional ByRef _Document As Variant _
1027 ) As Boolean
1029 ''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document
1030 ''' Args:
1031 ''' MenuHeader: the name/header of the menu, without tilde "~", as a case-sensitive string
1032 ''' _Document: undocumented argument to designate the document where the menu is located
1033 ''' Returns:
1034 ''' True when successful
1035 ''' Examples:
1037 ''' ' ...
1039 Dim bRemove As Boolean ' Return value
1040 Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager
1041 Dim oMenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar
1042 Dim sName As String ' Menu name
1043 Dim iMenuId As Integer ' Menu identifier
1045 Dim i As Integer
1051 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1052 bRemove = False
1054 Check:
1055 If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component
1056 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1057 If Not _IsStillAlive() Then GoTo Finally
1058 If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally
1059 End If
1061 Try:
1062 Set oLayout = _Document.CurrentController.Frame.LayoutManager
1065 ' Search the menu identifier to remove by its name, Mark its position
1066 With oMenuBar
1067 iMenuPosition = -1
1069 iMenuId = .getItemId(i)
1070 sName = Replace(.getItemText(iMenuId), cstTilde, "")
1071 If MenuHeader= sName Then
1072 iMenuPosition = i
1073 Exit For
1074 End If
1075 Next i
1076 ' Remove the found menu item
1078 .removeItem(iMenuPosition, 1)
1079 bRemove = True
1080 End If
1081 End With
1083 Finally:
1084 RemoveMenu = bRemove
1085 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1086 Exit Function
1087 Catch:
1088 GoTo Finally
1089 End Function ' SFDocuments.SF_Document.RemoveMenu
1091 REM -----------------------------------------------------------------------------
1092 Public Sub RunCommand(Optional ByVal Command As Variant _
1093 , ParamArray Args As Variant _
1094 )
1095 ''' Run on the current document window the given menu command. The command is executed with or without arguments
1096 ''' A few typical commands:
1097 ''' Save, SaveAs, ExportToPDF, SetDocumentProperties, Undo, Copy, Paste, ...
1098 ''' Dozens can be found on next page: https://wiki.documentfoundation.org/Development/DispatchCommands
1099 ''' Args:
1100 ''' Command: Case-sensitive. The command itself is not checked.
1102 ''' If nothing happens, then the command is probably wrong
1103 ''' Args: Pairs of arguments name (string), value (any)
1104 ''' Returns:
1105 ''' Examples:
1106 ''' oDoc.RunCommand("EditDoc", "Editable", False) ' Toggle edit mode
1108 Dim vArgs As Variant ' Alias of Args
1109 Dim oDispatch ' com.sun.star.frame.DispatchHelper
1110 Dim vProps As Variant ' Array of PropertyValues
1111 Dim vValue As Variant ' A single value argument
1112 Dim sCommand As String ' Alias of Command
1113 Dim i As Long
1119 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1121 Check:
1122 ' When called from a subclass (Calc, Writer, ..) the arguments are gathered into one single array item
1123 vArgs = Args
1124 If IsArray(Args) Then
1127 End If
1128 End If
1129 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1130 If Not _IsStillAlive() Then GoTo Finally
1131 If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Finally
1134 If Not ScriptForge.SF_Utils._Validate(vArgs(i), "Arg" & CStr(i/2) & "Name", V_STRING) Then GoTo Finally
1135 Next i
1136 End If
1138 Try:
1139 ' Build array of property values
1140 vProps = Array()
1143 vProps = ScriptForge.SF_Array.Append(vProps, ScriptForge.SF_Utils._MakePropertyValue(vArgs(i), vValue))
1144 Next i
1146 If ScriptForge.SF_String.StartsWith(Command, cstPrefix) Then sCommand = Command Else sCommand = cstPrefix & Command
1149 Finally:
1150 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1151 Exit Sub
1152 Catch:
1153 GoTo Finally
1154 End Sub ' SFDocuments.SF_Document.RunCommand
1156 REM -----------------------------------------------------------------------------
1157 Public Function Save() As Boolean
1158 ''' Store the document to the file location from which it was loaded
1159 ''' Ignored if the document was not modified
1160 ''' Args:
1161 ''' Returns:
1162 ''' False if the document could not be saved
1163 ''' Exceptions:
1164 ''' DOCUMENTSAVEERROR The file has been opened readonly or was opened as new and was not yet saved
1165 ''' Examples:
1166 ''' If Not oDoc.Save() Then
1167 ''' ' ...
1169 Dim bSaved As Boolean ' return value
1171 Const cstSubArgs = ""
1173 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1174 bSaved = False
1176 Check:
1177 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1178 If Not _IsStillAlive() Then GoTo Finally
1179 bSaved = False
1181 Try:
1182 With _Component
1183 If .isReadonly() Or Not .hasLocation() Then GoTo CatchReadonly
1184 If .IsModified() Then
1185 .store()
1186 bSaved = True
1187 End If
1188 End With
1190 Finally:
1191 Save = bSaved
1192 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1193 Exit Function
1194 Catch:
1195 GoTo Finally
1196 CatchReadonly:
1198 GoTo Finally
1199 End Function ' SFDocuments.SF_Document.Save
1201 REM -----------------------------------------------------------------------------
1202 Public Function SaveAs(Optional ByVal FileName As Variant _
1203 , Optional ByVal Overwrite As Variant _
1204 , Optional ByVal Password As Variant _
1205 , Optional ByVal FilterName As Variant _
1206 , Optional ByVal FilterOptions As Variant _
1207 ) As Boolean
1208 ''' Store the document to the given file location
1209 ''' The new location becomes the new file name on which simple Save method calls will be applied
1210 ''' Args:
1211 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
1212 ''' Overwrite: True if the destination file may be overwritten (default = False)
1213 ''' Password: Use to protect the document
1214 ''' FilterName: the name of a filter that should be used for saving the document
1215 ''' If present, the filter must exist
1216 ''' FilterOptions: an optional string of options associated with the filter
1217 ''' Returns:
1218 ''' False if the document could not be saved
1219 ''' Exceptions:
1220 ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
1221 ''' Examples:
1224 Dim bSaved As Boolean ' return value
1225 Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
1226 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1227 Dim sFile As String ' Alias of FileName
1228 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
1229 Dim FSO As Object ' SF_FileSystem
1231 Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]"
1233 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
1234 bSaved = False
1236 Check:
1237 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
1238 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
1239 If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = ""
1240 If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = ""
1242 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1243 If Not _IsStillAlive() Then GoTo Finally
1245 If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
1248 If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally
1249 End If
1251 ' Check that the filter exists
1254 If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError
1255 End If
1257 ' Check destination file overwriting
1259 sFile = FSO._ConvertToUrl(FileName)
1260 If FSO.FileExists(FileName) Then
1261 If Overwrite = False Then GoTo CatchError
1263 If oSfa.isReadonly(sFile) Then GoTo CatchError
1264 End If
1266 Try:
1267 ' Setup arguments
1268 If Len(Password) + Len(FilterName) = 0 Then
1269 vProperties = Array()
1270 Else
1271 vProperties = Array( _
1274 )
1276 vProperties = ScriptForge.SF_Array.Append(vProperties _
1278 End If
1279 End If
1281 _Component.StoreAsURL(sFile, vProperties)
1283 ' Remind the new file name
1284 _WindowFileName = sFile
1285 _WindowName = FSO.GetName(FileName)
1286 bSaved = True
1288 Finally:
1289 SaveAs = bSaved
1290 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1291 Exit Function
1292 Catch:
1293 GoTo Finally
1294 CatchError:
1295 ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
1297 GoTo Finally
1298 End Function ' SFDocuments.SF_Document.SaveAs
1300 REM -----------------------------------------------------------------------------
1301 Public Function SaveCopyAs(Optional ByVal FileName As Variant _
1302 , Optional ByVal Overwrite As Variant _
1303 , Optional ByVal Password As Variant _
1304 , Optional ByVal FilterName As Variant _
1305 , Optional ByVal FilterOptions As Variant _
1306 ) As Boolean
1307 ''' Store a copy or export the document to the given file location
1308 ''' The actual location is unchanged
1309 ''' Args:
1310 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
1311 ''' Overwrite: True if the destination file may be overwritten (default = False)
1312 ''' Password: Use to protect the document
1313 ''' FilterName: the name of a filter that should be used for saving the document
1314 ''' If present, the filter must exist
1315 ''' FilterOptions: an optional string of options associated with the filter
1316 ''' Returns:
1317 ''' False if the document could not be saved
1318 ''' Exceptions:
1319 ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected
1320 ''' Examples:
1323 Dim bSaved As Boolean ' return value
1324 Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
1325 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1326 Dim sFile As String ' Alias of FileName
1327 Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue
1328 Dim FSO As Object ' SF_FileSystem
1330 Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]"
1332 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
1333 bSaved = False
1335 Check:
1336 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
1337 If IsMissing(Password) Or IsEmpty(Password) Then Password = ""
1338 If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = ""
1339 If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = ""
1341 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1342 If Not _IsStillAlive() Then GoTo Finally
1344 If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
1347 If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally
1348 End If
1350 ' Check that the filter exists
1353 If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError
1354 End If
1356 ' Check destination file overwriting
1358 sFile = FSO._ConvertToUrl(FileName)
1359 If FSO.FileExists(FileName) Then
1360 If Overwrite = False Then GoTo CatchError
1362 If oSfa.isReadonly(sFile) Then GoTo CatchError
1363 End If
1365 Try:
1366 ' Setup arguments
1367 If Len(Password) + Len(FilterName) = 0 Then
1368 vProperties = Array()
1369 Else
1370 vProperties = Array( _
1373 )
1375 vProperties = ScriptForge.SF_Array.Append(vProperties _
1377 End If
1378 End If
1380 _Component.StoreToURL(sFile, vProperties)
1381 bSaved = True
1383 Finally:
1384 SaveCopyAs = bSaved
1385 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1386 Exit Function
1387 Catch:
1388 GoTo Finally
1389 CatchError:
1390 ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _
1392 GoTo Finally
1393 End Function ' SFDocuments.SF_Document.SaveCopyAs
1395 REM -----------------------------------------------------------------------------
1396 Public Function SetPrinter(Optional ByVal Printer As Variant _
1397 , Optional ByVal Orientation As Variant _
1398 , Optional ByVal PaperFormat As Variant _
1399 , Optional ByRef _PrintComponent As Variant _
1400 ) As Boolean
1401 ''' Define the printer options for the document
1402 ''' Args:
1403 ''' Printer: the name of the printer queue where to print to
1404 ''' When absent or space, the default printer is set
1405 ''' Orientation: either "PORTRAIT" or "LANDSCAPE". Left unchanged when absent
1406 ''' PaperFormat: one of next values
1407 ''' "A3", "A4", "A5", "B4", "B5", "LETTER", "LEGAL", "TABLOID"
1408 ''' Left unchanged when absent
1409 ''' _PrintComponent: undocumented argument to determine the component
1410 ''' Useful typically to apply printer settings on a Base form document
1411 ''' Returns:
1412 ''' True when successful
1413 ''' Examples:
1416 Dim bPrinter As Boolean ' Return value
1417 Dim vPrinters As Variant ' Array of known printers
1418 Dim vOrientations As Variant ' Array of allowed paper orientations
1419 Dim vPaperFormats As Variant ' Array of allowed formats
1420 Dim vPrinterSettings As Variant ' Array of property values
1421 Dim oPropertyValue As New com.sun.star.beans.PropertyValue
1422 ' A single property value item
1424 Const cstSubArgs = "[Printer=""""], [Orientation=""PORTRAIT""|""LANDSCAPE""]" _
1425 & ", [PaperFormat=""A3""|""A4""|""A5""|""B4""|""B5""|""LETTER""|""LEGAL""|""TABLOID"""
1427 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1428 bPrinter = False
1430 Check:
1431 If IsMissing(Printer) Or IsEmpty(Printer) Then Printer = ""
1432 If IsMissing(Orientation) Or IsEmpty(Orientation) Then Orientation = ""
1433 If IsMissing(PaperFormat) Or IsEmpty(PaperFormat) Then PaperFormat = ""
1434 If IsMissing(_PrintComponent) Or IsEmpty(_PrintComponent) Then Set _PrintComponent = _Component
1436 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional validation
1437 If Not _IsStillAlive() Then GoTo Finally
1438 If VarType(Printer) = V_STRING Then
1439 vPrinters = ScriptForge.SF_Platform.Printers
1441 If Not ScriptForge.SF_Utils._Validate(Printer, "Printer", V_STRING, vPrinters, True) Then GoTo Finally
1442 End If
1443 Else
1444 If Not ScriptForge.SF_Utils._Validate(Printer, "Printer", V_STRING) Then GoTo Finally ' Manage here the VarType error
1445 End If
1446 If VarType(Orientation) = V_STRING Then
1449 If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, vOrientations) Then GoTo Finally
1450 End If
1451 Else
1452 If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING) Then GoTo Finally
1453 End If
1454 If VarType(PaperFormat) = V_STRING Then
1455 vPaperFormats = Array("A3", "A4", "A5", "B4", "B5", "LETTER", "LEGAL", "TABLOID")
1457 If Not ScriptForge.SF_Utils._Validate(PaperFormat, "PaperFormat", V_STRING, vPaperFormats) Then GoTo Finally
1458 End If
1459 Else
1460 If Not ScriptForge.SF_Utils._Validate(PaperFormat, "PaperFormat", V_STRING) Then GoTo Finally
1461 End If
1463 Try:
1464 With _PrintComponent
1465 Set oPropertyValue = ScriptForge.SF_Utils._MakePropertyValue("Name", Iif(Len(Printer) > 0, Printer, vPrinters(0)))
1466 vPrinterSettings = Array(oPropertyValue)
1468 vPrinterSettings = ScriptForge.SF_Utils._SetPropertyValue(vPrinterSettings, "PaperOrientation" _
1469 , ScriptForge.SF_Array.IndexOf(vOrientations, Orientation, CaseSensitive := False))
1470 End If
1472 vPrinterSettings = ScriptForge.SF_Utils._SetPropertyValue(vPrinterSettings, "PaperFormat" _
1473 , ScriptForge.SF_Array.IndexOf(vPaperFormats, PaperFormat, CaseSensitive := False))
1474 End If
1475 .setPrinter(vPrinterSettings)
1476 End With
1477 bPrinter = True
1479 Finally:
1480 SetPrinter = bPrinter
1481 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1482 Exit Function
1483 Catch:
1484 GoTo Finally
1485 End Function ' SFDocuments.SF_Document.SetPrinter
1487 REM -----------------------------------------------------------------------------
1488 Private Function SetProperty(Optional ByVal psProperty As String _
1489 , Optional ByVal pvValue As Variant _
1490 ) As Boolean
1491 ''' Set the new value of the named property
1492 ''' Args:
1493 ''' psProperty: the name of the property
1494 ''' pvValue: the new value of the given property
1495 ''' Returns:
1496 ''' True if successful
1498 Dim bSet As Boolean ' Return value
1499 Static oSession As Object ' Alias of SF_Session
1500 Dim cstThisSub As String
1503 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1504 bSet = False
1507 If IsMissing(pvValue) Then pvValue = Empty
1508 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets
1510 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1511 bSet = True
1512 Select Case UCase(psProperty)
1514 CustomProperties = pvValue
1516 Description = pvValue
1518 Keywords = pvValue
1520 Subject = pvValue
1522 Title = pvValue
1523 Case Else
1524 bSet = False
1525 End Select
1527 Finally:
1528 SetProperty = bSet
1529 'ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1530 Exit Function
1531 Catch:
1532 GoTo Finally
1533 End Function ' SFDocuments.SF_Document.SetProperty
1535 REM -----------------------------------------------------------------------------
1536 Public Function Styles(Optional ByVal Family As Variant _
1537 , Optional ByVal NamePattern As variant _
1538 , Optional ByVal Used As variant _
1539 , Optional ByVal UserDefined As Variant _
1540 , Optional ByVal ParentStyle As Variant _
1541 , Optional ByVal Category As Variant _
1542 ) As Variant
1543 ''' Returns an array of style names matching the filters given in argument
1544 ''' Args:
1545 ''' Family: one of the style families present in the actual document, as a case-sensitive string
1546 ''' NamePattern: a filter on the style names, as a case-sensitive string pattern
1549 ''' The names include the internal and localized names.
1550 ''' Used: when True, the style must be used in the document
1551 ''' When absent, the argument is ignored.
1552 ''' UserDefined: when True, the style must have been added by the user, either in the document or its template
1553 ''' When absent, the argument is ignored.
1554 ''' ParentStyle: when present, only the children of the given, localized or not, parent style name are retained
1555 ''' Category: a case-insensitive string: TEXT, CHAPTER, LIST, INDEX, EXTRA, HTML
1556 ''' For their respective meanings, read https://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1style_1_1ParagraphStyleCategory.html
1557 ''' The argument is ignored when the Family is not = "ParagraphStyles".
1558 ''' Returns:
1559 ''' An array of style localized names
1560 ''' An error is raised when the Family does not exist.
1561 ''' The returned array may be empty.
1562 ''' Example:
1563 ''' Dim vStyles As Variant
1564 ''' vStyles = doc.Styles("ParagraphStyles") ' All styles in the family
1565 ''' vStyles = doc.Styles("ParagraphStyles", "H*") ' Heading, Heading 1, ...
1566 ''' vStyles = doc.Styles("ParagraphStyles", Used := False, UserDefined := True)
1567 ''' ' All user-defined styles that are not used
1568 ''' vStyles = doc.Styles("ParagraphStyles", ParentStyle := "Standard")
1571 Dim vStyles As Variant ' Return value
1572 Dim sStyle As String ' A single style name
1573 Dim oFamily As Object ' Style names container
1574 Dim oStyle As Object ' _StyleDescriptor
1575 Dim oParentStyle As Object ' _StyleDescriptor
1576 Dim bValid As Boolean ' When True, a given style passes the filter
1577 Dim i As Integer
1581 Const cstSubArgs = "Family, [NamePattern=""*""], [Used=True|False], [UserDefined=True|False], ParentStyle = """"" _
1582 & ", [Category=""""|""TEXT""|""CHAPTER""|""LIST""|""INDEX""|""EXTRA""|""HTML""]"
1584 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1585 vStyles = Array()
1587 Check:
1588 If IsMissing(NamePattern) Or IsEmpty(NamePattern) Then NamePattern = ""
1589 If IsMissing(Used) Then Used = Empty
1590 If IsMissing(UserDefined) Then UserDefined = Empty
1591 If IsMissing(ParentStyle) Or IsEmpty(ParentStyle) Then ParentStyle = ""
1592 If IsMissing(Category) Or IsEmpty(Category) Then Category = ""
1593 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1594 If Not _IsStillAlive() Then GoTo Finally
1595 If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames()
1596 If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally
1597 If Not ScriptForge.SF_Utils._Validate(NamePattern, "NamePattern", V_STRING) Then GoTo Finally
1598 If Not IsEmpty(Used) Then
1599 If Not ScriptForge.SF_Utils._Validate(Used, "Used", ScriptForge.V_BOOLEAN) Then GoTo Finally
1600 End If
1601 If Not IsEmpty(UserDefined) Then
1602 If Not ScriptForge.SF_Utils._Validate(UserDefined, "UserDefined", ScriptForge.V_BOOLEAN) Then GoTo Finally
1603 End If
1604 If Not ScriptForge.SF_Utils._Validate(ParentStyle, "ParentStyle", V_STRING) Then GoTo Finally
1605 If Not ScriptForge.SF_Utils._Validate(Category, "Category", V_STRING, Split("," & cstCategories, ",")) Then GoTo Finally
1606 End If
1608 Try:
1609 Set oFamily = _GetStyleFamily(Family)
1610 If Not IsNull(oFamily) Then
1611 ' Load it with the complete list of styles in the family
1612 vStyles = oFamily.getElementNames()
1613 ' Scan the list and retain those passing the filter
1614 For i = 0 To UBound(vStyles)
1615 sStyle = vStyles(i)
1616 Set oStyle = _GetStyle(oFamily, sStyle)
1617 If Not IsNull(oStyle) Then
1618 With oStyle
1619 ' Pattern ?
1620 bValid = ( Len(NamePattern) = 0 )
1621 If Not bValid Then bValid = ScriptForge.SF_String.IsLike(.DisplayName, NamePattern, CaseSensitive := True)
1622 ' Used ?
1623 If bValid And Not IsEmpty(Used) Then bValid = ( Used = .IsUsed )
1624 ' User defined ?
1625 If bValid And Not IsEmpty(UserDefined) Then bValid = ( UserDefined = Not .BuiltIn )
1626 ' Parent style ?
1628 Set oParentStyle = _GetStyle(oFamily, .ParentStyle)
1629 bValid = Not IsNull(oParentStyle) ' The child has a parent
1630 If bValid Then bValid = ( ParentStyle = oParentStyle.DisplayName Or ParentStyle = oParentStyle.StyleName)
1631 End If
1632 ' Category ?
1634 If bValid Then vStyles(i) = .DisplayName Else vStyles(i) = ""
1635 End With
1636 Else
1637 vStyles(i) = ""
1638 End If
1639 Next i
1640 ' Reject when not valid
1641 vStyles = ScriptForge.SF_Array.TrimArray(vStyles)
1642 End If
1644 Finally:
1645 Styles = vStyles
1646 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1647 Exit Function
1648 Catch:
1649 GoTo Finally
1650 End Function ' SFDocuments.SF_Document.Styles
1652 REM -----------------------------------------------------------------------------
1653 Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant
1654 ''' Returns either a list of the available toolbar names in the actual document
1655 ''' or a Toolbar object instance.
1656 ''' Args:
1657 ''' ToolbarName: the usual name of one of the available toolbars
1658 ''' Returns:
1659 ''' A zero-based array of toolbar names when the argument is absent,
1660 ''' or a new Toolbar object instance from the SF_Widgets library.
1665 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1667 Check:
1668 If IsMissing(ToolbarName) Or IsEmpty(ToolbarName) Then ToolbarName = ""
1669 If IsNull(_Toolbars) Then _Toolbars = ScriptForge.SF_UI._ListToolbars(_Component)
1670 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1671 If Not _IsStillAlive() Then GoTo Finally
1672 If VarType(ToolbarName) = V_STRING Then
1674 If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING, _Toolbars.Keys()) Then GoTo Finally
1675 End If
1676 Else
1677 If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING) Then GoTo Finally ' Manage here the VarType error
1678 End If
1679 End If
1681 Try:
1682 If Len(ToolbarName) = 0 Then
1683 Toolbars = _Toolbars.Keys()
1684 Else
1686 End If
1688 Finally:
1689 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1690 Exit Function
1691 Catch:
1692 GoTo Finally
1693 End Function ' SFDocuments.SF_Document.Toolbars
1695 REM -----------------------------------------------------------------------------
1696 Public Function XStyle(Optional ByVal Family As Variant _
1697 , Optional ByVal StyleName As variant _
1698 ) As Object
1699 ''' Returns a com.sun.star.style.Style UNO object corresponding with the arguments
1700 ''' Args:
1701 ''' Family: one of the style families present in the actual document, as a not case-sensitive string
1702 ''' StyleName: one of the styles present in the given family, as a case-sensitive string
1703 ''' The StyleName may be localized or not.
1704 ''' Returns:
1705 ''' A com.sun.star.style.XStyle UNO object or one of its descendants,
1706 ''' like com.sun.star.style.CellStyle or com.sun.star.style.ParagraphStyle etc.
1707 ''' An error is raised when the Family does not exist.
1708 ''' Nothing is returned when the StyleName does not exist in the given Family.
1709 ''' Example:
1710 ''' Dim oStyle As Object
1713 Dim oXStyle As Object ' Return value
1714 Dim oFamily As Object ' Style names container
1719 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1720 Set oXStyle = Nothing
1722 Check:
1723 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1724 If Not _IsStillAlive() Then GoTo Finally
1725 If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames()
1726 If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally
1727 If Not ScriptForge.SF_Utils._Validate(StyleName, "StyleName", V_STRING) Then GoTo Finally
1728 End If
1730 Try:
1731 Set oFamily = _GetStyleFamily(Family)
1732 If Not IsNull(oFamily) Then
1733 If oFamily.hasByName(StyleName) Then Set oXStyle = oFamily.getByName(StyleName)
1734 End If
1736 Finally:
1737 Set XStyle = oXStyle
1738 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1739 Exit Function
1740 Catch:
1741 GoTo Finally
1742 End Function ' SFDocuments.SF_Document.XStyle
1744 REM =========================================================== PRIVATE FUNCTIONS
1746 REM -----------------------------------------------------------------------------
1747 Private Function _FileIdent() As String
1748 ''' Returns a file identification from the information that is currently available
1749 ''' Useful e.g. for display in error messages
1751 ' OS notation is used to avoid presence of "%nn" in error messages and wrong parameter substitutions
1754 End Function ' SFDocuments.SF_Document._FileIdent
1756 REM -----------------------------------------------------------------------------
1757 Private Function _GetFilterNames(ByVal pbExport As Boolean) As Variant
1758 ''' Returns the list of export (pbExport = True) or import filters
1759 ''' applicable to the current document
1760 ''' Args:
1761 ''' pbExport: True for export, False for import
1762 ''' Returns:
1763 ''' A zero-based array of strings
1765 Dim vFilters As Variant ' Return value
1766 Dim sIdentifier As String ' Document service, like com.sun.star.text.TextDocument
1767 Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
1768 Dim vAllFilters As Variant ' The full list of installed filters
1769 Dim sFilter As String ' A single filter name
1770 Dim iCount As Integer ' Filters counter
1771 Dim vFilter As Variant ' A filter descriptor as an array of Name/Value pairs
1772 Dim sType As String ' The filter type to be compared with the document service
1773 Dim lFlags As Long ' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Office_Development#Properties_of_a_Filter
1774 Dim bExport As Boolean ' Filter valid for export when True
1775 Dim bImport As Boolean ' Filter valid for import when True
1776 Dim bImportExport As Boolean ' Filter valid both for import and export when True
1778 vFilters = Array()
1779 On Local Error GoTo Finally ' Return empty or partial list if error
1781 Try:
1782 sIdentifier = _Component.Identifier
1784 vAllFilters = oFilterFactory.getElementNames()
1785 ReDim vFilters(0 To UBound(vAllFilters))
1786 iCount = -1
1788 For Each sFilter In vAllFilters
1789 vFilter = oFilterFactory.getByName(sFilter)
1791 If sType = sIdentifier Then
1793 ' export: flag is even
1799 ' Select filter ?
1800 If bImportExport _
1801 Or (pbExport And bExport) _
1802 Or (Not pbExport And bImport) Then
1803 iCount = iCount + 1
1804 vFilters(iCount) = sFilter
1805 End If
1806 End If
1807 Next sFilter
1810 ReDim Preserve vFilters(0 To iCount)
1811 End If
1813 Finally:
1814 _GetFilterNames = vFilters
1815 Exit Function
1816 End Function ' SFDocuments.SF_Document._GetFilterNames
1818 REM -----------------------------------------------------------------------------
1819 Private Function _GetStyle(ByRef poFamily As Object _
1820 , Optional ByVal pvDisplayName As Variant _
1821 , Optional ByVal pvStyleIndex As Variant _
1822 ) As Object
1823 ''' Returns the style descriptor of the style passed as argument in the given family
1824 ''' Args:
1825 ''' poFamily: a com.sun.star.container.XNameContainer/XStyleFamily object
1826 ''' pvDisplayName: case-sensitive string, localized style name as visible in the user interface
1827 ''' pvStyleIndex: index of the style in the family, as an integer
1829 ''' Returns:
1830 ''' A StyleDescriptor object or Nothing
1832 Dim oStyleDescriptor ' Return value
1833 Dim oStyle As Object ' com.sun.star.style.XStyle and variants
1834 Dim bFound As Boolean ' When True, the style has been found in the family
1835 Dim vCategories As Variant ' Array of category constants
1836 Dim iCategory As Integer ' Index of vCategories
1837 Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
1838 Dim i As Integer
1842 Const cstCAT2 = "LIST" ' is applied to styles that are used in numberings and lists
1844 Const cstCAT4 = "EXTRA" ' is applied to styles that are used in special regions like headers, footers, and footnote text
1846 Const cstCAT = cstCAT0 & "," & cstCAT1 & "," & cstCAT2 & "," & cstCAT3 & "," & cstCAT4 & "," & cstCAT5
1848 On Local Error GoTo Catch
1849 Set oStyleDescriptor = Nothing
1851 Check:
1852 If IsNull(poFamily) Then GoTo Catch
1853 If IsMissing(pvDisplayName) Or IsEmpty(pvDisplayName) Then pvDisplayName = ""
1854 If IsMissing(pvStyleIndex) Or IsEmpty(pvStyleIndex) Then pvStyleIndex = -1
1855 Try:
1856 ' Find style corresponding with the given display name
1857 With poFamily
1859 bFound = .hasByName(pvDisplayName) ' hasByName searches both for Name and DisplayName attributes here
1860 If bFound Then Set oStyle = .getByName(pvDisplayName) Else GoTo Catch
1862 Set oStyle = .getByIndex(pvStyleIndex)
1863 Else
1864 GoTo Catch ' Should not happen
1865 End If
1866 End With
1868 ' Setup the style descriptor
1869 Set oStyleDescriptor = New StyleDescriptor
1870 With oStyleDescriptor
1871 Set .Family = poFamily
1872 .StyleName = oStyle.Name
1873 .DisplayName = oStyle.DisplayName
1874 .IsUsed = oStyle.isInUse
1875 .BuiltIn = Not oStyle.isUserDefined()
1876 .Category = ""
1879 iCategory = oStyle.Category
1880 If iCategory >= 0 And iCategory <= UBound(vCategories) Then .Category = vCategories(iCategory)
1881 End If
1882 .ParentStyle = oStyle.ParentStyle
1883 Set .XStyle = oStyle
1884 End With
1886 Finally:
1887 Set _GetStyle = oStyleDescriptor
1888 Exit Function
1889 Catch:
1890 Set oStyleDescriptor = Nothing
1891 GoTo Finally
1892 End Function ' SFDocuments.SF_Document._GetStyle
1894 REM -----------------------------------------------------------------------------
1895 Private Function _GetStyleFamily(ByVal psFamilyName As String) As Object
1896 ''' Returns the style names container corresponding with the argument
1897 ''' Args:
1898 ''' psFamilyName: CellStyles, CharacterStyles, FrameStyles, GraphicsStyles, ListStyles,
1899 ''' NumberingStyles, PageStyles, ParagraphStyles, TableStyles
1900 ''' Returns:
1901 ''' A com.sun.star.container.XNameContainer/XStyleFamily object or Nothing
1903 Dim oFamily As Object ' Return value
1904 Dim oFamilies As Object ' com.sun.star.container.XNameAccess
1905 Dim iIndex As Integer ' Index in vFamilies of the given argument
1907 On Local Error GoTo Catch
1908 Set oFamily = Nothing
1910 Try:
1911 Set oFamilies = _Component.getStyleFamilies()
1913 ' oFamilies.hasByName()/getByName() not used here to admit not case-sensitive family names
1914 iIndex = ScriptForge.SF_Array.IndexOf(_StyleFamilies, psFamilyName, CaseSensitive := False)
1917 Finally:
1918 Set _GetStyleFamily = oFamily
1919 Exit Function
1920 Catch:
1921 Set oFamily = Nothing
1922 GoTo Finally
1923 End Function ' SFDocuments.SF_Document._GetStyleFamily
1925 REM -----------------------------------------------------------------------------
1926 Public Sub _ImportStylesFromFile(Optional FileName As Variant _
1927 , Optional ByRef Families As Variant _
1928 , Optional ByVal Overwrite As variant _
1929 ) As Variant
1930 ''' Load all the styles belonging to one or more style families from a closed file
1931 ''' into the actual document. The actual document must be a Calc or a Writer document.
1932 ''' Are always imported together:
1933 ''' ParagraphStyles and CharacterStyles
1934 ''' NumberingStyles and ListStyles
1935 ''' Args:
1936 ''' FileName: the file from which to load the styles in the FileSystem notation.
1937 ''' The file is presumed to be of the same document type as the actual document
1938 ''' Families: one of the style families present in the actual document, as a case-sensitive string
1939 ''' or an array of such strings. Default = all families
1940 ''' Overwrite: when True, the actual styles may be overwritten. Default = False
1941 ''' Returns:
1942 ''' Exceptions:
1943 ''' UNKNOWNFILEERROR The given file name does not exist
1944 ''' Example:
1945 ''' oDoc.ImportStylesFromFile("C:\...\abc.odt", Families := "ParagraphStyles", Overwrite := True)
1947 Dim vFamilies As Variant ' Alias of Families
1948 Dim oFamilies As Object ' com.sun.star.container.XNameAccess
1949 Dim vOptions As Variant ' Array of property values
1950 Dim bAll As Boolean ' When True, ALL style families are considered
1951 Dim sName As String ' A single name in vOptions
1952 Dim FSO As Object : Set FSO = ScriptForge.SF_FileSystem
1953 Dim i As Integer
1957 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1959 Check:
1960 If IsMissing(Families) Or IsEmpty(Families) Then Families = ""
1961 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
1963 Set oFamilies = _Component.getStyleFamilies()
1966 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1967 If Not _IsStillAlive() Then GoTo Finally
1968 If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName", False) Then GoTo Finally
1969 If IsArray(Families) Then
1970 If Not ScriptForge.SF_Utils._ValidateArray(Families, "Families", 1, V_STRING, True) Then GoTo Finally
1971 Else
1972 If Not ScriptForge.SF_Utils._Validate(Families, "Families", V_STRING, ScriptForge.SF_Array.Append(_StyleFamilies, "")) Then GoTo Finally
1973 End If
1974 If Not ScriptForge.SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
1975 End If
1977 If Not FSO.FileExists(FileName) Then GoTo CatchNotExists
1978 If IsArray(Families) Then
1979 vFamilies = Families
1980 Else
1981 bAll = ( Len(Families) = 0 ) ' When Families is absent (= ""), all families should be considered
1982 vFamilies = Array(Families)
1983 End If
1985 Try:
1986 With ScriptForge.SF_Utils
1987 Set vOptions = _Component.getStyleFamilies().getStyleLoaderOptions
1988 ' By default, all style families are imported (True)
1989 If Not bAll Then
1990 For i = 0 To UBound(vOptions)
1991 vOptions(i).Value = False
1992 Next i
1993 For i = LBound(vFamilies) To UBound(vFamilies)
1994 Select Case UCase(vFamilies(i))
2000 Case Else : sName = ""
2001 End Select
2002 If Len(sName) > 0 Then Set vOptions = ._SetPropertyValue(vOptions, "Load" & sName, True)
2003 Next i
2004 End If
2006 End With
2008 ' Finally, import
2009 oFamilies.loadStylesFromURL(FSO._ConvertToUrl(FileName), vOptions)
2011 Finally:
2012 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2013 Exit Sub
2014 Catch:
2015 GoTo Finally
2016 CatchNotExists:
2018 GoTo Finally
2019 End Sub ' SFDocuments.SF_Document._ImportStylesFromFile
2021 REM -----------------------------------------------------------------------------
2022 Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _
2023 , Optional ByVal pbError As Boolean _
2024 ) As Boolean
2025 ''' Returns True if the document has not been closed manually or incidentally since the last use
2026 ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
2027 ''' Args:
2028 ''' pbForUpdate: if True (default = False), check additionally if document is open for editing
2029 ''' pbError: if True (default), raise a fatal error
2031 Dim bAlive As Boolean ' Return value
2032 Dim sFileName As String ' File identification used to display error message
2034 On Local Error GoTo Catch ' Anticipate DisposedException errors or alike
2035 If IsMissing(pbForUpdate) Then pbForUpdate = False
2036 If IsMissing(pbError) Then pbError = True
2038 Try:
2039 ' Check existence of document
2040 bAlive = Not IsNull(_Frame)
2041 If bAlive Then bAlive = Not IsNull(_Component)
2042 If bAlive Then bAlive = Not IsNull(_Component.CurrentController)
2044 ' Check document is not read only
2045 If bAlive And pbForUpdate Then
2046 If _Component.isreadonly() Then GoTo CatchReadonly
2047 End If
2049 Finally:
2050 _IsStillAlive = bAlive
2051 Exit Function
2052 Catch:
2053 bAlive = False
2054 On Error GoTo 0
2055 sFileName = _FileIdent()
2056 Dispose()
2057 If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sFileName)
2058 GoTo Finally
2059 CatchReadonly:
2060 bAlive = False
2061 If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTREADONLYERROR, "Document", _FileIdent())
2062 GoTo Finally
2063 End Function ' SFDocuments.SF_Document._IsStillAlive
2065 REM -----------------------------------------------------------------------------
2066 Private Function _ListContextMenus() As Variant
2067 ''' Returns an array of the usual names of the context menus available in the current document
2069 Dim vMenus As Variant ' Return value
2070 Dim vMenusObj As Variant ' Array of arrays of property values
2071 Dim oSupplier As Object ' /singletons/com.sun.star.ui.theModuleUIConfigurationManagerSupplier
2072 Dim sComponentType As String ' Argument to determine the system config manager, ex. "com.sun.star.text.TextDocument"
2073 Dim oUIConf As Object ' com.sun.star.ui.XUIConfigurationManager
2074 Dim i As Long
2076 On Local Error GoTo Catch
2077 vMenus = Array()
2079 Try:
2080 Set oSupplier = ScriptForge.SF_Utils._GetUNOService("ModuleUIConfigurationManagerSupplier")
2081 sComponentType = ScriptForge.SF_UI._GetConfigurationManager(_Component)
2082 Set oUIConf = oSupplier.getUIConfigurationManager(sComponentType)
2084 ' Discard menubar, statusbar, ...
2085 vMenusObj = oUIConf.getUIElementsInfo(com.sun.star.ui.UIElementType.POPUPMENU)
2087 ' Extract and sort the names
2088 ReDim vMenus(0 To UBound(vMenusObj))
2089 For i = 0 To UBound(vMenusObj)
2091 Next i
2092 vMenus = ScriptForge.SF_Array.Unique(vMenus, CaseSensitive := True)
2094 Finally:
2095 _ListContextMenus = vMenus
2096 Exit Function
2097 Catch:
2098 On Local Error GoTo 0
2099 GoTo Finally
2100 End Function ' SFDocuments.SF_Document._ListContextMenus
2102 REM -----------------------------------------------------------------------------
2103 Private Sub _LoadDocumentProperties()
2104 ''' Create dictionary with document properties as entries / Custom properties are excluded
2105 ''' Document is presumed still alive
2106 ''' Special values:
2107 ''' Only valid dates are taken
2108 ''' Statistics are exploded in subitems. Subitems are specific to document type
2109 ''' Keywords are joined
2110 ''' Language is aligned on L10N convention la-CO
2112 Dim oProperties As Object ' Document properties
2113 Dim vNamedValue As Variant ' com.sun.star.beans.NamedValue
2115 If IsNull(_DocumentProperties) Then
2116 Set oProperties = _Component.getDocumentProperties
2118 With _DocumentProperties
2122 If oProperties.CreationDate.Year > 0 Then .Add("CreationDate", CDateFromUnoDateTime(oProperties.CreationDate))
2125 ' DocumentStatistics : number and names of statistics depend on document type
2126 For Each vNamedValue In oProperties.DocumentStatistics
2127 .Add(vNamedValue.Name, vNamedValue.Value)
2128 Next vNamedValue
2132 .Add("Language", oProperties.Language.Language & Iif(Len(oProperties.Language.Country) > 0, "-" & oProperties.Language.Country, ""))
2133 If oProperties.ModificationDate.Year > 0 Then .Add("ModificationDate", CDateFromUnoDateTime(oProperties.ModificationDate))
2134 If oProperties.PrintDate.Year > 0 Then .Add("PrintDate", CDateFromUnoDateTime(oProperties.PrintDate))
2137 If oProperties.TemplateDate.Year > 0 Then .Add("TemplateDate", CDateFromUnoDateTime(oProperties.TemplateDate))
2141 End With
2142 End If
2144 End Sub ' SFDocuments.SF_Document._LoadDocumentProperties
2146 REM -----------------------------------------------------------------------------
2147 Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
2148 ''' Return the value of the named property
2149 ''' Args:
2150 ''' psProperty: the name of the property
2152 Dim oProperties As Object ' Document or Custom properties
2153 Dim oTransient As Object ' com.sun.star.frame.TransientDocumentsDocumentContentFactory
2154 Dim oContent As Object ' com.sun.star.comp.ucb.TransientDocumentsContent
2155 Dim cstThisSub As String
2156 Const cstSubArgs = ""
2158 _PropertyGet = False
2160 Select Case _DocumentType
2162 cstThisSub = "SFDocuments.SF_" & _DocumentType & ".get" & psProperty
2164 End Select
2165 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
2167 If Not _IsStillAlive() Then GoTo Finally
2168 End If
2170 Select Case psProperty
2172 _CustomProperties = CreateScriptService("Dictionary", True) ' Always reload as updates could have been done manually by user
2173 ' (with case-sensitive comparison of keys)
2174 _CustomProperties.ImportFromPropertyValues(_Component.getDocumentProperties().UserDefinedProperties.getPropertyValues)
2175 _PropertyGet = _CustomProperties
2177 _PropertyGet = _Component.DocumentProperties.Description
2179 _LoadDocumentProperties() ' Always reload as updates could have been done manually by user
2180 Set _PropertyGet = _DocumentProperties
2182 _PropertyGet = _DocumentType
2184 _PropertyGet = _GetFilterNames(True)
2186 ' Natural choice would have been to use the component.RunTimeUID property
2187 ' However it is optional in the OfficeDocument service and not available for Base documents
2188 ' Below a more generic alternative derived from the get_document_uri() method found in apso.py
2190 Set oContent = oTransient.createDocumentContent(_Component)
2193 _PropertyGet = _GetFilterNames(False)
2195 _PropertyGet = _IsStillAlive(False, False)
2196 Case "IsBase", "IsCalc", "IsDraw", "IsFormDocument", "IsImpress", "IsMath", "IsWriter"
2197 _PropertyGet = ( Mid(psProperty, 3) = _DocumentType )
2201 _PropertyGet = _Component.isReadonly()
2203 If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames()
2204 _PropertyGet = _StyleFamilies
2206 _PropertyGet = _Component.DocumentProperties.Subject
2208 _PropertyGet = _Component.DocumentProperties.Title
2210 Set _PropertyGet = _Component
2212 With _Component
2213 If IsNull(_DocumentSettings) Then
2214 Select Case _DocumentType
2215 Case "Calc" : Set _DocumentSettings = .createInstance("com.sun.star.sheet.DocumentSettings")
2216 Case "Draw" : Set _DocumentSettings = .createInstance("com.sun.star.drawing.DocumentSettings")
2219 Case "Impress" : Set _DocumentSettings = .createInstance("com.sun.star.presentation.DocumentSettings")
2220 Case Else : Set _DocumentSettings = Nothing
2221 End Select
2222 End If
2223 Set _PropertyGet = _DocumentSettings
2224 End With
2225 Case Else
2226 _PropertyGet = Null
2227 End Select
2229 Finally:
2230 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2231 Exit Function
2232 End Function ' SFDocuments.SF_Document._PropertyGet
2234 REM -----------------------------------------------------------------------------
2235 Private Function _Repr() As String
2236 ''' Convert the SF_Document instance to a readable string, typically for debugging purposes (DebugPrint ...)
2237 ''' Args:
2238 ''' Return:
2243 End Function ' SFDocuments.SF_Document._Repr
2245 REM ============================================ END OF SFDOCUMENTS.SF_DOCUMENT
2246 </script:module>