[BASIC] Advanced printing macro's

Creating Extension - Shared Libraries
Forum rules
For sharing working examples of macros / scripts. These can be in any script language supported by OpenOffice.org [Basic, Python, Netbean] or as source code files in Java or C# even - but requires the actual source code listing. This forum is not for asking questions about writing your own macros.

[BASIC] Advanced printing macro's

Postby zenlord » Tue Oct 09, 2012 5:48 pm

Hi,
New round of my printing macro's. Features:
1. Select output trays
2. Select background on/off (usefull to print on stationary)
3. Convert a letter to PDF and attach it to a new e-mail
4. Select printer (NEW)

To use these macro's as-is (at your own risk, of course), just c/p the code to your document, make a few buttons and assign them to the macro's fax_close, mail_close, etc. and import the dialog that I have attached (not possible due to unsupported extension - just design a simple dialog with a listbox and an 'OK'-button).

Code: Select all   Expand viewCollapse view
Removed (see post below)


If you can help me with adding some error handling, that would be nice ;)
Last edited by zenlord on Thu Oct 11, 2012 9:42 pm, edited 1 time in total.
LibreOffice 4.1 on Linux (Debian Wheezy backports)
zenlord
 
Posts: 51
Joined: Tue Dec 22, 2009 5:50 pm

Re: [BASIC] Advanced printing macro's

Postby zenlord » Thu Oct 11, 2012 9:42 pm

Added ErrorHandling, rewrote some comments, added insertDTstampLastPage:

Newer version down below!

Code: Select all   Expand viewCollapse view
REM ** VERSIONING **
'Version 2.0 (11 okt 2012)
'Added simple ErrorHandler and rewrote comments

REM  *****  BASIC  *****

Sub Main
   REM Set backgroundImage-option in DocumentSettings to True
   DIM oDoc, oSettings AS Object
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = TRUE
End Sub


REM ** GENERAL HELPERS **

' ------------------------------
' This macro closes the current document
'
' Written by Andrew Pitonyak (2010)
' Adapted by Vincent Van Houtte (2011)
' ------------------------------
Sub closeDocument(oDoc AS Object)
   REM Check if the document exists
   If IsNull(oDoc) Then
      Exit Sub
   End If

   REM Store the document if it was modified
   If (oDoc.isModified) Then
     If (oDoc.hasLocation AND (Not oDoc.isReadOnly)) Then
       oDoc.store()
     Else
       oDoc.setModified(False)
     End If
   End If

   REM Close the document
   oDoc.close(true)
End Sub

' ------------------------------
' Written by Andrew Pitonyak the Great
' Used in the Date-time-functions
' ------------------------------
Function FindCreateNumberFormatStyle ( sFormat As String, Optional doc, Optional locale)
   Dim oDoc As Object
   Dim aLocale As New com.sun.star.lang.Locale
   Dim oFormats As Object
   Dim formatNum As Integer
   oDoc = IIf(IsMissing(doc), ThisComponent, doc)
   oFormats = oDoc.getNumberFormats()
   'If you choose to query on types, you need to use the type
   'com.sun.star.util.NumberFormat.DATE
   'I could set the locale from values stored at
   'http://www.ics.uci.edu/pub/ietf/http/related/iso639.txt
   'http://www.chemie.fu-berlin.de/diverse/doc/ISO_3166.html
   'I use a NULL locale and let it use whatever it likes.
   'First, see if the number format exists
   If ( Not IsMissing(locale)) Then
   aLocale = locale
   End If
   formatNum = oFormats.queryKey (sFormat, aLocale, TRUE)
   'MsgBox "Current Format number is" & formatNum
   'If the number format does not exist then add it
   If (formatNum = -1) Then
   formatNum = oFormats.addNew(sFormat, aLocale)
   If (formatNum = -1) Then formatNum = 0
   '   MsgBox "new Format number is " & formatNum
   End If
   FindCreateNumberFormatStyle = formatNum
End Function


REM ** HELPER MACRO'S TO INSERT / REMOVE A DATESTAMP**

' ------------------------------
' This macro inserts a 'DATE/TIME'-stamp with sActionText
' like 'Printed' or 'Sent'
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub InsertDTstampFirstPage(sActionText)
   DIM oCursor, oText, oDoc AS Object
   oDoc = ThisComponent
   oText = oDoc.getText()
   oCursor = oText.createTextCursor()
   oCursor.goToStart(FALSE)

   REM Create the date and time objects
   DIM oDate, oTime AS Object
   oDate = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oDate.IsFixed = TRUE
   oDate.IsDate = TRUE
   oDate.NumberFormat = FindCreateNumberFormatStyle("D MMMM JJJJ", oDoc)
   
   oTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oTime.IsFixed = True
   oTime.IsDate = False
   oTime.NumberFormat = FindCreateNumberFormatStyle("UU:MM", oDoc)

   REM Create the frame
   DIM oFrameDT AS Object
   oFrameDT = oDoc.createInstance("com.sun.star.text.TextFrame")
   With oFrameDT
   .setName("FrameDT")
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
   .HoriOrient = com.sun.star.text.HoriOrientation.NONE
   .VertOrient = com.sun.star.text.VertOrientation.NONE
   .HoriOrientPosition = -4200
   .VertOrientPosition = -4000
   .width = 4000
   .height = 1500
   .BorderDistance = 100
   End With

   REM Insert the frame into the text document
   oText.insertTextContent( oCursor, oFrameDT, True )

   REM Write the text inside the frame
   DIM oCursor2 AS Object
   oCursor2 = oFrameDT.createTextCursor()
   With oCursor2
   .charHeight = 13
   .charWeight = com.sun.star.awt.FontWeight.BOLD
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertString( oCursor2, sActionText, False )

   With oCursor2
   .charHeight = 9
   .charWeight = com.sun.star.awt.FontWeight.NORMAL
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oDate, False )

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.LINE_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oTime, False )
End Sub


' ------------------------------
' This macro inserts a 'DATE/TIME'-stamp with sActionText
' like 'Printed', 'Copy', 'Books' or 'Sent'
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Sub InsertDTstampLastPage(sActionText)
   DIM oCursor, oText, oDoc AS Object
   oDoc = ThisComponent
   oText = oDoc.getText()
   oCursor = oText.createTextCursor()
   oCursor.goToEnd(FALSE)

   REM Create the date and time objects
   DIM oDate, oTime AS Object
   oDate = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oDate.IsFixed = TRUE
   oDate.IsDate = TRUE
   oDate.NumberFormat = FindCreateNumberFormatStyle("D MMMM JJJJ", oDoc)
   
   oTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oTime.IsFixed = True
   oTime.IsDate = False
   oTime.NumberFormat = FindCreateNumberFormatStyle("UU:MM", oDoc)

   REM Create the frame
   DIM oFrameDT AS Object
   oFrameDT = oDoc.createInstance("com.sun.star.text.TextFrame")
   With oFrameDT
   .setName("FrameDT")
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
   .HoriOrient = com.sun.star.text.HoriOrientation.NONE
   .VertOrient = com.sun.star.text.VertOrientation.NONE
   .HoriOrientPosition = -4200
   .VertOrientPosition = -2500
   .width = 4000
   .height = 1500
   .BorderDistance = 100
   End With

   REM Insert the frame into the text document
   oText.insertTextContent( oCursor, oFrameDT, True )

   REM Write the text inside the frame
   DIM oCursor2 AS Object
   oCursor2 = oFrameDT.createTextCursor()
   With oCursor2
   .charHeight = 13
   .charWeight = com.sun.star.awt.FontWeight.BOLD
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertString( oCursor2, sActionText, False )

   With oCursor2
   .charHeight = 9
   .charWeight = com.sun.star.awt.FontWeight.NORMAL
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oDate, False )

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.LINE_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oTime, False )
End Sub



' ------------------------------
' This macro removes the 'DATE/TIME'-stamp created with
' the previous macro
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub RemoveDTstamp()
   DIM oDoc, oTextFrames, oFrameDT AS Object
   oDoc = ThisComponent

   REM Look for the datetimestamp-frame and remove it
   oTextFrames = oDoc.getTextFrames
   If oTextFrames.hasByName("FrameDT") Then
      oFrameDT = oTextFrames.getByName("FrameDT")
      oFrameDT.dispose()
   EndIf
End Sub


REM ** HELPER PRINTING FUNCTIONS **

' ------------------------------
' This macro shows a dialog with a list of all installed printers on your system.
' Ideally, the dialog closes after a selection has been made
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Function ShowListPrinters
   DIM aPrinterNames

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   aPrinterNames = GetAllPrinterNames()

   DialogLibraries.loadLibrary("Standard")
   d = CreateUnoDialog(DialogLibraries.Standard.dlgListPrinters)
      d.setTitle("Selecteer printer")
      l = d.getControl("ListPrinters")
      l.getModel().StringItemList = aPrinterNames
      l.selectItemPos( 0, true )
   d.execute()
      list = d.getModel().getByName("ListPrinters")
      result = list.StringItemList(list.SelectedItems(0))
   d.dispose()
   ShowListPrinters = result

'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function


' ------------------------------
' This macro returns an array with a list of all installed printers. It is possible
' that it doesn't work on older (pre OOo3.5) versions of OOo / LO
'
' Written by Niklas Nebel (cited by Andrew Pitonyak)
' Adapted very slightly by Vincent Van Houtte (2012)
' ------------------------------
Function GetAllPrinterNames()
   DIM oPrintServer ' The print server service.
   DIM oCore        ' Get classes and other objects by name.
   DIM oClass       ' XPrinterServer class object.
   DIM oMethod      ' getPrinterNames method from the XPrinterServer class.

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   ' Create the object that will not be directly usable until OOo 3.5.
   oPrintServer = CreateUnoService("com.sun.star.awt.PrinterServer")
   oCore = CreateUnoService("com.sun.star.reflection.CoreReflection")

   ' Get the class object for the XPrinterServer interface.
   oClass = oCore.forName("com.sun.star.awt.XPrinterServer")

   ' Get the getPrinterNames method for the XPrinterServer class.
   oMethod = oClass.getMethod("getPrinterNames")

   ' Call the getPrinterNames method on the PrinterServer object.
   GetAllPrinterNames = oMethod.invoke(oPrintServer, Array())

'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function


REM ** HELPER PRINTING MACRO'S **

' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding the pre-printed (first-page-)stationary:
' you can set an image as a background, that you don't want to print,
' but that you want to show up when converted to PDF.
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_stat_first(iPageNr, sPrinter)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray2"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding the pre-printed (other-page-)stationary:
' you can set an image as a background, that you don't want to print,
' but that you want to show up when converted to PDF.
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_stat_rest(iPageNr, sPrinter)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding plain paper, for example to keep in your own file
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_plain(iPageNr, sPrinter)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page with the background(-image) to the
' papertray holding plain paper, for example to keep in your official books
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Sub Print_plain_with_background(iPageNr, sPrinter)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = True
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a specified page given the chosen parameters
'
' Written by Vincent Van Houtte (2010)
' ------------------------------
Sub printPage(sTray, bBg, sPageNr AS String, sPrinter)
   DIM oDoc AS Object
   oDoc = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   REM Set backgroundImage-option in DocumentSettings to False
   DIM oSettings AS Object
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = bBg

   REM Set the chosen printer
   DIM mPrinterOpts(2) AS NEW com.sun.star.beans.PropertyValue
   mPrinterOpts(0).Name = "Name"
   'mPrinterOpts(0).Value = "MFC8880DN"
   mPrinterOpts(0).Value = sPrinter
   mPrinterOpts(1).Name = "PaperFormat"
   mPrinterOpts(1).Value = com.sun.star.view.PaperFormat.A4
   mPrinterOpts(2).Name = "PaperOrientation"
   mPrinterOpts(2).Value = com.sun.star.view.PaperOrientation.PORTRAIT
   oDoc.Printer = mPrinterOpts()

   REM set Papertray in Styles
   DIM oStyle, oViewCursor, oPageStyleName, oPageStyles AS Object
   DIM iPageNr AS Integer
   iPageNr = sPageNr
   oViewCursor = oDoc.CurrentController.getViewCursor()
   oViewCursor.JumpToPage(iPageNr, false)
   oPageStyleName = oViewCursor.PageStyleName
   oPageStyles = oDoc.StyleFamilies.getByName("PageStyles")
   oStyle = oPageStyles.getByName(oPageStyleName)
   'If the printer has but one tray, comment the next line out:
   oStyle.PrinterPaperTray = sTray

   REM Set printOptions
   DIM mPrintOpts(3) AS NEW com.sun.star.beans.PropertyValue
   mPrintOpts(0).Name = "CopyCount"
   mPrintOpts(0).Value = 1
   mPrintOpts(1).Name = "Collate"
   mPrintOpts(1).Value = True
   mPrintOpts(2).Name = "Pages"
   mPrintOpts(2).Value = sPageNr
   mPrintOpts(3).Name = "Wait"
   mPrintOpts(3).Value = True

   REM Print
   oDoc.Print(mPrintOpts())

   REM RESET OPTIONS
   REM Set backgroundImage-option in DocumentSettings to True
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = True

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints the complete document given the chosen parameters
'
' Written by Vincent Van Houtte (2010)
' ------------------------------
Sub printDoc(sTray, bBg, sPrinter)
   DIM oDoc AS Object
   oDoc = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   REM Set backgroundImage-option in DocumentSettings to False
   DIM oSettings AS Object
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = bBg

   REM Set the chosen printer
   DIM mPrinterOpts(2) AS NEW com.sun.star.beans.PropertyValue
   mPrinterOpts(0).Name = "Name"
   'mPrinterOpts(0).Value = "MFC8880DN"
   mPrinterOpts(0).Value = sPrinter
   mPrinterOpts(1).Name = "PaperFormat"
   mPrinterOpts(1).Value = com.sun.star.view.PaperFormat.A4
   mPrinterOpts(2).Name = "PaperOrientation"
   mPrinterOpts(2).Value = com.sun.star.view.PaperOrientation.PORTRAIT
   oDoc.Printer = mPrinterOpts()

   REM set Papertray in Styles
   DIM oStyle, oViewCursor, oPageStyleName, oPageStyles AS Object
   DIM iPageNr AS Integer
   iPageNr = sPageNr
   oViewCursor = oDoc.CurrentController.getViewCursor()
   oViewCursor.JumpToPage(iPageNr, false)
   oPageStyleName = oViewCursor.PageStyleName
   oPageStyles = oDoc.StyleFamilies.getByName("PageStyles")
   oStyle = oPageStyles.getByName(oPageStyleName)
   'If the printer has but one tray, comment the next line out:
   oStyle.PrinterPaperTray = sTray

   REM Set printOptions
   DIM mPrintOpts(2) AS NEW com.sun.star.beans.PropertyValue
   mPrintOpts(0).Name = "CopyCount"
   mPrintOpts(0).Value = 1
   mPrintOpts(1).Name = "Collate"
   mPrintOpts(1).Value = True
   mPrintOpts(2).Name = "Wait"
   mPrintOpts(2).Value = True

   REM Print
   oDoc.Print(mPrintOpts())

   REM RESET OPTIONS
   REM Set backgroundImage-option in DocumentSettings to True
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = True

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub



REM ** PRINTING MACRO'S ASSIGNED TO BUTTONS**

' ------------------------------
' This macro prints the document once to stationary and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Fax_close()
   DIM oDoc, oCursor, oText AS Object
   DIM iPageCount, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM I don't know why the next 3 lines are here - probably leftovers from a precious version
   'oText   = oDoc.getText()
   'oCursor   = oText.createTextCursor()
   'oCursor.goToStart(FALSE)

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   n = 2
   While n <= iPageCount
      Print_stat_rest(n, sPrinter)
      n = n + 1
   Wend

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints a copy of the document, sends the
' document to the default email app as a PDF and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Mail_close()
   DIM oDoc, oCursor, oText AS Object
   DIM iPageCount, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print copy
   REM Insert timestamp of sending
   Dim sActionText AS String
   sActionText = "VERZONDEN"
   InsertDTstampFirstPage(sActionText)

   REM Print the page
   REM Loop over every page
   n = 1
   Do Until n > iPageCount
      Print_plain(n, sPrinter)
      n = n + 1
   Loop

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Create PDF
   REM Replace .odt with .pdf
   DIM sDocURL, sPDFURL AS String
   sDocURL = oDoc.getURL()
   sPDFURL = Left$(sDocURL,Len(sDocURL)-4) + ".pdf"

   REM Save as PDF
   DIM args(0) AS NEW com.sun.star.beans.PropertyValue
   args(0).Name = "FilterName"
   args(0).Value = "writer_pdf_Export"
   oDoc.storeToURL(sPDFURL,args())

'Send to mailapp
   REM Get the values of the textfields inside the document to form the subject line
   DIM enuTF, aTextField AS Object
   DIM sDosName, sDosNum, sDosUref, sTo, sSubject AS String
   enuTF = oDoc.TextFields.createEnumeration
      Do While enuTF.hasMoreElements
      aTextField = enuTF.nextElement
         if aTextField.supportsService("com.sun.star.text.TextField.Input") then
            Select Case aTextField.getPropertyValue("Hint")
               Case "briefBetreft":
                  sDosName = aTextField.getPropertyValue("Content")
               Case "briefOnzeReferte":
                  sDosNum = aTextField.getPropertyValue("Content")
               Case "briefUwReferte":
                  sDosUref = aTextField.getPropertyValue("Content")
               Case "verzendingsadres":
                  sTo = aTextField.getPropertyValue("Content")
            End Select
         end if
      Loop
   sSubject = sDosName + " - " + sDosUref + " - " + sDosNum

   REM Send the PDF as an attachment
   DIM MailClient, MailAgent, MailMessage AS Object
   'On linux systems, use SimpleCommandMail
   MailAgent = CreateUnoService("com.sun.star.system.SimpleCommandMail")
   'On windows systems, use SimpleSystemMail
   'MailAgent = CreateUnoService("com.sun.star.system.SimpleSystemMail")
   MailClient = MailAgent.querySimpleMailClient()
      MailMessage=MailClient.createSimpleMailMessage()
      MailMessage.setRecipient(sTo)
      MailMessage.setSubject(sSubject)
      MailMessage.setAttachement(array(sPDFURL))
   MailClient.sendSimpleMailMessage(MailMessage, 0)

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub

Sub Letter_close()
' ------------------------------
' This macro prints the document once to stationary, once as a copy and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
   DIM oDoc, oCursor, oText AS Object
   DIM iPageCount, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   n = 2
   While n <= iPageCount
      Print_stat_rest(n, sPrinter)
      n = n + 1
   Wend

'Print copy
   REM Insert timestamp of sending
   Dim sActionText AS String
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Print the page
   REM Loop over every page
   n = 1
   Do Until n > iPageCount
      Print_plain(n, sPrinter)
      n = n + 1
   Loop
   
   REM Remove the copystamp-frame
   RemoveDTstamp()

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub

Sub Letter_recommended_close()
' ------------------------------
' This macro prints the document twice to stationary, once as a copy and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
   DIM oDoc, oCursor, oText AS Object
   DIM iPageCount, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   n = 2
   While n <= iPageCount
      Print_stat_rest(n, sPrinter)
      n = n + 1
   Wend

'Print stat second
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   n = 2
   While n <= iPageCount
      Print_stat_rest(n, sPrinter)
      n = n + 1
   Wend

'Print copy
   REM Insert timestamp of sending
   Dim sActionText AS String
   sActionText = "AANGETEKEND"
   InsertDTstampFirstPage(sActionText)

   REM Print the page
   REM Loop over every page
   n = 1
   Do Until n > iPageCount
      Print_plain(n, sPrinter)
      n = n + 1
   Loop
   
   REM Remove the copystamp-frame
   RemoveDTstamp()

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints a copy of the document, and makes a
' PDF-doc with copy-stamp
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_copy()
   DIM oDoc, oCursor, oText AS Object
   DIM iPageCount, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print copy
   REM Insert timestamp of sending
   Dim sActionText AS String
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Print the page
   REM Loop over every page
   n = 1
   Do Until n > iPageCount
      Print_plain(n, sPrinter)
      n = n + 1
   Loop

'Create PDF
   REM Replace .odt with _cp.pdf
   DIM sDocURL, sPDFURL AS String
   sDocURL = oDoc.getURL()
   sPDFURL = Left$(sDocURL,Len(sDocURL)-4) + "_cp.pdf"

   REM Save as PDF
   DIM args(0) AS NEW com.sun.star.beans.PropertyValue
   args(0).Name = "FilterName"
   args(0).Value = "writer_pdf_Export"
   oDoc.storeToURL(sPDFURL,args())

   REM Remove the copystamp-frame
   RemoveDTstamp()

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub
Last edited by zenlord on Mon Oct 15, 2012 12:14 pm, edited 1 time in total.
LibreOffice 4.1 on Linux (Debian Wheezy backports)
zenlord
 
Posts: 51
Joined: Tue Dec 22, 2009 5:50 pm

Re: [BASIC] Advanced printing macro's

Postby zenlord » Mon Oct 15, 2012 12:12 pm

Thx to Bmarcelly, I have added the option 'Explicit', which in turn revealed some small errors that are now fixed:

Newer version down below!

Code: Select all   Expand viewCollapse view
REM ** VERSIONING **
'Version 2.0.1 (12 okt 2012)
' Thanks To Bernard Marcelly, I have added explicit declarations everywhere
'  and simplified the loops
'Version 2.0 (11 okt 2012)
' Added simple ErrorHandler and rewrote comments

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

Sub Main
   REM Set backgroundImage-option in DocumentSettings to True
   DIM oDoc AS Object, oSettings AS Object
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = TRUE
End Sub


REM ** GENERAL HELPERS **

' ------------------------------
' This macro closes the current document
'
' Written by Andrew Pitonyak (2010)
' Adapted by Vincent Van Houtte (2011)
' ------------------------------
Sub closeDocument(oDoc AS Object)
   REM Check if the document exists
   If IsNull(oDoc) Then
      Exit Sub
   End If

   REM Store the document if it was modified
   If (oDoc.isModified) Then
     If (oDoc.hasLocation AND (Not oDoc.isReadOnly)) Then
       oDoc.store()
     Else
       oDoc.setModified(False)
     End If
   End If

   REM Close the document
   oDoc.close(true)
End Sub

' ------------------------------
' Written by Andrew Pitonyak the Great
' Used in the Date-time-functions
' ------------------------------
Function FindCreateNumberFormatStyle ( sFormat As String, Optional doc, Optional locale)
   Dim oDoc As Object
   Dim aLocale As New com.sun.star.lang.Locale
   Dim oFormats As Object
   Dim formatNum As Integer
   oDoc = IIf(IsMissing(doc), ThisComponent, doc)
   oFormats = oDoc.getNumberFormats()
   'If you choose to query on types, you need to use the type
   'com.sun.star.util.NumberFormat.DATE
   'I could set the locale from values stored at
   'http://www.ics.uci.edu/pub/ietf/http/related/iso639.txt
   'http://www.chemie.fu-berlin.de/diverse/doc/ISO_3166.html
   'I use a NULL locale and let it use whatever it likes.
   'First, see if the number format exists
   If ( Not IsMissing(locale)) Then
   aLocale = locale
   End If
   formatNum = oFormats.queryKey (sFormat, aLocale, TRUE)
   'MsgBox "Current Format number is" & formatNum
   'If the number format does not exist then add it
   If (formatNum = -1) Then
   formatNum = oFormats.addNew(sFormat, aLocale)
   If (formatNum = -1) Then formatNum = 0
   '   MsgBox "new Format number is " & formatNum
   End If
   FindCreateNumberFormatStyle = formatNum
End Function


REM ** HELPER MACRO'S TO INSERT / REMOVE A DATESTAMP**

' ------------------------------
' This macro inserts a 'DATE/TIME'-stamp with sActionText
' like 'Printed' or 'Sent'
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub InsertDTstampFirstPage(sActionText AS String)
   DIM oCursor AS Object, oText AS Object, oDoc AS Object
   oDoc = ThisComponent
   oText = oDoc.getText()
   oCursor = oText.createTextCursor()
   oCursor.goToStart(FALSE)

   REM Create the date and time objects
   DIM oDate AS Object, oTime AS Object
   oDate = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oDate.IsFixed = TRUE
   oDate.IsDate = TRUE
   oDate.NumberFormat = FindCreateNumberFormatStyle("D MMMM JJJJ", oDoc)
   
   oTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oTime.IsFixed = True
   oTime.IsDate = False
   oTime.NumberFormat = FindCreateNumberFormatStyle("UU:MM", oDoc)

   REM Create the frame
   DIM oFrameDT AS Object
   oFrameDT = oDoc.createInstance("com.sun.star.text.TextFrame")
   With oFrameDT
   .setName("FrameDT")
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
   .HoriOrient = com.sun.star.text.HoriOrientation.NONE
   .VertOrient = com.sun.star.text.VertOrientation.NONE
   .HoriOrientPosition = -4200
   .VertOrientPosition = -4000
   .width = 4000
   .height = 1500
   .BorderDistance = 100
   End With

   REM Insert the frame into the text document
   oText.insertTextContent( oCursor, oFrameDT, True )

   REM Write the text inside the frame
   DIM oCursor2 AS Object
   oCursor2 = oFrameDT.createTextCursor()
   With oCursor2
   .charHeight = 13
   .charWeight = com.sun.star.awt.FontWeight.BOLD
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertString( oCursor2, sActionText, False )

   With oCursor2
   .charHeight = 9
   .charWeight = com.sun.star.awt.FontWeight.NORMAL
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oDate, False )

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.LINE_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oTime, False )
End Sub


' ------------------------------
' This macro inserts a 'DATE/TIME'-stamp with sActionText
' like 'Printed', 'Copy', 'Books' or 'Sent'
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Sub InsertDTstampLastPage(sActionText AS String)
   DIM oCursor AS Object, oText AS Object, oDoc AS Object
   oDoc = ThisComponent
   oText = oDoc.getText()
   oCursor = oText.createTextCursor()
   oCursor.goToEnd(FALSE)

   REM Create the date and time objects
   DIM oDate AS Object, oTime AS Object
   oDate = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oDate.IsFixed = TRUE
   oDate.IsDate = TRUE
   oDate.NumberFormat = FindCreateNumberFormatStyle("D MMMM JJJJ", oDoc)
   
   oTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oTime.IsFixed = True
   oTime.IsDate = False
   oTime.NumberFormat = FindCreateNumberFormatStyle("UU:MM", oDoc)

   REM Create the frame
   DIM oFrameDT AS Object
   oFrameDT = oDoc.createInstance("com.sun.star.text.TextFrame")
   With oFrameDT
   .setName("FrameDT")
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
   .HoriOrient = com.sun.star.text.HoriOrientation.NONE
   .VertOrient = com.sun.star.text.VertOrientation.NONE
   .HoriOrientPosition = -4200
   .VertOrientPosition = -4000
   .width = 4000
   .height = 1500
   .BorderDistance = 100
   End With

   REM Insert the frame into the text document
   oText.insertTextContent( oCursor, oFrameDT, True )

   REM Write the text inside the frame
   DIM oCursor2 AS Object
   oCursor2 = oFrameDT.createTextCursor()
   With oCursor2
   .charHeight = 13
   .charWeight = com.sun.star.awt.FontWeight.BOLD
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertString( oCursor2, sActionText, False )

   With oCursor2
   .charHeight = 9
   .charWeight = com.sun.star.awt.FontWeight.NORMAL
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oDate, False )

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.LINE_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oTime, False )
End Sub



' ------------------------------
' This macro removes the 'DATE/TIME'-stamp created with
' the previous macro
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub RemoveDTstamp()
   DIM oDoc AS Object, oTextFrames AS Object, oFrameDT AS Object
   oDoc = ThisComponent

   REM Look for the datetimestamp-frame and remove it
   oTextFrames = oDoc.getTextFrames
   If oTextFrames.hasByName("FrameDT") Then
      oFrameDT = oTextFrames.getByName("FrameDT")
      oFrameDT.dispose()
   EndIf
End Sub


REM ** HELPER PRINTING FUNCTIONS **

' ------------------------------
' This macro shows a dialog with a list of all installed printers on your system.
' Ideally, the dialog closes after a selection has been made
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Function ShowListPrinters
   DIM aPrinterNames(10)
   DIM d AS Object, l AS Object, list AS Object, result(10)

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   aPrinterNames = GetAllPrinterNames()

   DialogLibraries.loadLibrary("Standard")
   d = CreateUnoDialog(DialogLibraries.Standard.dlgListPrinters)
      d.setTitle("Selecteer printer")
      l = d.getControl("ListPrinters")
      l.getModel().StringItemList = aPrinterNames
      l.selectItemPos( 0, true )
   d.execute()
      list = d.getModel().getByName("ListPrinters")
      result = list.StringItemList(list.SelectedItems(0))
   d.dispose()
   ShowListPrinters = result

'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function


' ------------------------------
' This macro returns an array with a list of all installed printers. It is possible
' that it doesn't work on older (pre OOo3.5) versions of OOo / LO
'
' Written by Niklas Nebel (cited by Andrew Pitonyak)
' Adapted very slightly by Vincent Van Houtte (2012)
' ------------------------------
Function GetAllPrinterNames()
   DIM oPrintServer AS Object ' The print server service.
   DIM oCore AS Object        ' Get classes and other objects by name.
   DIM oClass AS Object       ' XPrinterServer class object.
   DIM oMethod AS Object      ' getPrinterNames method from the XPrinterServer class.

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   ' Create the object that will not be directly usable until OOo 3.5.
   oPrintServer = CreateUnoService("com.sun.star.awt.PrinterServer")
   oCore = CreateUnoService("com.sun.star.reflection.CoreReflection")

   ' Get the class object for the XPrinterServer interface.
   oClass = oCore.forName("com.sun.star.awt.XPrinterServer")

   ' Get the getPrinterNames method for the XPrinterServer class.
   oMethod = oClass.getMethod("getPrinterNames")

   ' Call the getPrinterNames method on the PrinterServer object.
   GetAllPrinterNames = oMethod.invoke(oPrintServer, Array())

'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function


REM ** HELPER PRINTING MACRO'S **

' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding the pre-printed (first-page-)stationary:
' you can set an image as a background, that you don't want to print,
' but that you want to show up when converted to PDF.
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_stat_first(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray2"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding the pre-printed (other-page-)stationary:
' you can set an image as a background, that you don't want to print,
' but that you want to show up when converted to PDF.
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_stat_rest(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding plain paper, for example to keep in your own file
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_plain(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page with the background(-image) to the
' papertray holding plain paper, for example to keep in your official books
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Sub Print_plain_with_background(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = True
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a specified page given the chosen parameters
'
' Written by Vincent Van Houtte (2010)
' ------------------------------
Sub printPage(sTray AS String, bBg AS Boolean, sPageNr AS String, sPrinter AS String)
   DIM oDoc AS Object
   oDoc = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   REM Set backgroundImage-option in DocumentSettings to False
   DIM oSettings AS Object
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = bBg

   REM Set the chosen printer
   DIM mPrinterOpts(2) AS NEW com.sun.star.beans.PropertyValue
   mPrinterOpts(0).Name = "Name"
   mPrinterOpts(0).Value = sPrinter
   mPrinterOpts(1).Name = "PaperFormat"
   mPrinterOpts(1).Value = com.sun.star.view.PaperFormat.A4
   mPrinterOpts(2).Name = "PaperOrientation"
   mPrinterOpts(2).Value = com.sun.star.view.PaperOrientation.PORTRAIT
   oDoc.Printer = mPrinterOpts()

   REM cast sPageNr as a integer
   DIM iPageNr AS Integer
   iPageNr = sPageNr

   REM set Papertray in Styles
   DIM oStyle AS Object, oViewCursor AS Object, sPageStyleName AS String
   oViewCursor = oDoc.CurrentController.getViewCursor()
   oViewCursor.JumpToPage(iPageNr)
   sPageStyleName = oViewCursor.PageStyleName
   oStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(sPageStyleName)
   'If the printer has but one tray, comment the next line out:
   oStyle.PrinterPaperTray = sTray

   REM Set printOptions
   DIM mPrintOpts(3) AS NEW com.sun.star.beans.PropertyValue
   mPrintOpts(0).Name = "CopyCount"
   mPrintOpts(0).Value = 1
   mPrintOpts(1).Name = "Collate"
   mPrintOpts(1).Value = True
   mPrintOpts(2).Name = "Pages"
   mPrintOpts(2).Value = sPageNr
   mPrintOpts(3).Name = "Wait"
   mPrintOpts(3).Value = True

   REM Print or Debug
'   MsgBox sPageNr + " / " + sPageStyleName
'   Xray oViewCursor
   oDoc.Print(mPrintOpts())

   REM RESET OPTIONS
   REM Set backgroundImage-option in DocumentSettings to True
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = True
'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


REM ** PRINTING MACRO'S ASSIGNED TO BUTTONS**

' ------------------------------
' This macro prints the document once to stationary and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Fax_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints a copy of the document, sends the
' document to the default email app as a PDF and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Mail_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print copy
   REM Insert timestamp of sending
   sActionText = "VERZONDEN"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Create PDF
   REM Replace .odt with .pdf
   DIM sDocURL AS String, sPDFURL AS String
   sDocURL = oDoc.getURL()
   sPDFURL = Left$(sDocURL,Len(sDocURL)-4) + ".pdf"

   REM Save as PDF
   DIM args(0) AS NEW com.sun.star.beans.PropertyValue
   args(0).Name = "FilterName"
   args(0).Value = "writer_pdf_Export"
   oDoc.storeToURL(sPDFURL,args())

'Send to mailapp
   REM Get the values of the textfields inside the document to form the subject line
   DIM enuTF AS Object, aTextField AS Object
   DIM sDosName AS String, sDosNum AS String, sDosUref AS String, sTo AS String, sSubject AS String
   enuTF = oDoc.TextFields.createEnumeration
      Do While enuTF.hasMoreElements
      aTextField = enuTF.nextElement
         if aTextField.supportsService("com.sun.star.text.TextField.Input") then
            Select Case aTextField.getPropertyValue("Hint")
               Case "briefBetreft":
                  sDosName = aTextField.getPropertyValue("Content")
               Case "briefOnzeReferte":
                  sDosNum = aTextField.getPropertyValue("Content")
               Case "briefUwReferte":
                  sDosUref = aTextField.getPropertyValue("Content")
               Case "verzendingsadres":
                  sTo = aTextField.getPropertyValue("Content")
            End Select
         end if
      Loop
   sSubject = sDosName + " - " + sDosUref + " - " + sDosNum

   REM Send the PDF as an attachment
   DIM MailClient AS Object, MailAgent AS Object, MailMessage AS Object
   'On linux systems, use SimpleCommandMail
   MailAgent = CreateUnoService("com.sun.star.system.SimpleCommandMail")
   'On windows systems, use SimpleSystemMail
   'MailAgent = CreateUnoService("com.sun.star.system.SimpleSystemMail")
   MailClient = MailAgent.querySimpleMailClient()
      MailMessage=MailClient.createSimpleMailMessage()
      MailMessage.setRecipient(sTo)
      MailMessage.setSubject(sSubject)
      MailMessage.setAttachement(array(sPDFURL))
   MailClient.sendSimpleMailMessage(MailMessage, 0)

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub

' ------------------------------
' This macro prints the document once to stationary, once as a copy and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Letter_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Print copy
   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub

' ------------------------------
' This macro prints the document twice to stationary, once as a copy and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Letter_recommended_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Print stat second
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Print copy
   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints a copy of the document, and makes a
' PDF-doc with copy-stamp
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_copy()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print copy
   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Create PDF
   REM Replace .odt with _cp.pdf
   DIM sDocURL AS String, sPDFURL AS String
   sDocURL = oDoc.getURL()
   sPDFURL = Left$(sDocURL,Len(sDocURL)-4) + "_cp.pdf"

   REM Save as PDF
   DIM args(0) AS NEW com.sun.star.beans.PropertyValue
   args(0).Name = "FilterName"
   args(0).Value = "writer_pdf_Export"
   oDoc.storeToURL(sPDFURL,args())

   REM Remove the copystamp-frame
   RemoveDTstamp()

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub
Last edited by zenlord on Fri Oct 19, 2012 11:02 am, edited 1 time in total.
LibreOffice 4.1 on Linux (Debian Wheezy backports)
zenlord
 
Posts: 51
Joined: Tue Dec 22, 2009 5:50 pm

Re: [BASIC] Advanced printing macro's

Postby zenlord » Fri Oct 19, 2012 11:00 am

Development has been ongoing the past two weeks, and a new function has been added 'SmartClose' - you now only need two buttons: one to print and send out the document and one to print an extra copy of the letter. I also copied/wrote two functions to get the contents of an input-field / userinput-field and used that in the set of macro's:

Newer version below!

Code: Select all   Expand viewCollapse view
REM ** VERSIONING **
'Version 2.1 (19 okt 2012)
' Thanks To JohnV, I have added new functions to get the contents of (user)inputfields
' and applied them in a new 'Smart_close' -function that chooses
'  automatically, based on the contents of a certain inputfield, how the
'  letter should be printed / sent
'Version 2.0.1 (12 okt 2012)
' Thanks To Bernard Marcelly, I have added explicit declarations everywhere
'  and simplified the loops
'Version 2.0 (11 okt 2012)
' Added simple ErrorHandler and rewrote comments

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

Sub Main
   REM Set backgroundImage-option in DocumentSettings to True
   DIM oDoc AS Object, oSettings AS Object
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = TRUE
End Sub


REM ** GENERAL HELPERS **

' ------------------------------
' This macro closes the current document
'
' Written by Andrew Pitonyak (2010)
' Adapted by Vincent Van Houtte (2011)
' ------------------------------
Sub closeDocument(oDoc AS Object)
   REM Check if the document exists
   If IsNull(oDoc) Then
      Exit Sub
   End If

   REM Store the document if it was modified
   If (oDoc.isModified) Then
     If (oDoc.hasLocation AND (Not oDoc.isReadOnly)) Then
       oDoc.store()
     Else
       oDoc.setModified(False)
     End If
   End If

   REM Close the document
   oDoc.close(true)
End Sub

' ------------------------------
' Written by Andrew Pitonyak the Great
' Used in the Date-time-functions
' ------------------------------
Function FindCreateNumberFormatStyle ( sFormat As String, Optional doc, Optional locale)
   Dim oDoc As Object
   Dim aLocale As New com.sun.star.lang.Locale
   Dim oFormats As Object
   Dim formatNum As Integer
   oDoc = IIf(IsMissing(doc), ThisComponent, doc)
   oFormats = oDoc.getNumberFormats()
   'If you choose to query on types, you need to use the type
   'com.sun.star.util.NumberFormat.DATE
   'I could set the locale from values stored at
   'http://www.ics.uci.edu/pub/ietf/http/related/iso639.txt
   'http://www.chemie.fu-berlin.de/diverse/doc/ISO_3166.html
   'I use a NULL locale and let it use whatever it likes.
   'First, see if the number format exists
   If ( Not IsMissing(locale)) Then
   aLocale = locale
   End If
   formatNum = oFormats.queryKey (sFormat, aLocale, TRUE)
   'MsgBox "Current Format number is" & formatNum
   'If the number format does not exist then add it
   If (formatNum = -1) Then
   formatNum = oFormats.addNew(sFormat, aLocale)
   If (formatNum = -1) Then formatNum = 0
   '   MsgBox "new Format number is " & formatNum
   End If
   FindCreateNumberFormatStyle = formatNum
End Function


REM ** HELPER MACRO'S TO INSERT / REMOVE A DATESTAMP**

' ------------------------------
' This macro inserts a 'DATE/TIME'-stamp with sActionText
' like 'Printed' or 'Sent'
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub InsertDTstampFirstPage(sActionText AS String)
   DIM oCursor AS Object, oText AS Object, oDoc AS Object
   DIM oViewCursor AS Object
   oDoc = ThisComponent
   
   oViewCursor = oDoc.CurrentController.getViewCursor()
   oViewCursor.JumpToPage(1)
   oText = oDoc.getText()
   oCursor = oText.createTextCursor()
'   oCursor.goToEnd(FALSE)
   oCursor.goToRange( oViewCursor, FALSE )

   REM Create the date and time objects
   DIM oDate AS Object, oTime AS Object
   oDate = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oDate.IsFixed = TRUE
   oDate.IsDate = TRUE
   oDate.NumberFormat = FindCreateNumberFormatStyle("D MMMM JJJJ", oDoc)
   
   oTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oTime.IsFixed = True
   oTime.IsDate = False
   oTime.NumberFormat = FindCreateNumberFormatStyle("UU:MM", oDoc)

   REM Create the frame
   DIM oFrameDT AS Object
   oFrameDT = oDoc.createInstance("com.sun.star.text.TextFrame")
   With oFrameDT
   .setName("FrameDT")
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
   .HoriOrient = com.sun.star.text.HoriOrientation.NONE
   .VertOrient = com.sun.star.text.VertOrientation.NONE
   .HoriOrientPosition = -4200
   .VertOrientPosition = -3500
   .width = 4000
   .height = 1500
   .BorderDistance = 100
   End With

   REM Insert the frame into the text document
   oText.insertTextContent( oCursor, oFrameDT, True )

   REM Write the text inside the frame
   DIM oCursor2 AS Object
   oCursor2 = oFrameDT.createTextCursor()
   With oCursor2
   .charHeight = 13
   .charWeight = com.sun.star.awt.FontWeight.BOLD
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertString( oCursor2, sActionText, False )

   With oCursor2
   .charHeight = 9
   .charWeight = com.sun.star.awt.FontWeight.NORMAL
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oDate, False )

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.LINE_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oTime, False )
End Sub


' ------------------------------
' This macro inserts a 'DATE/TIME'-stamp with sActionText
' like 'Printed', 'Copy', 'Books' or 'Sent'
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Sub InsertDTstampLastPage(sActionText AS String)
   DIM oCursor AS Object, oText AS Object, oDoc AS Object
   DIM oViewCursor AS Object
   DIM iPageCount AS Integer
   oDoc = ThisComponent
   
   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

   REM Position the cursor
   oViewCursor = oDoc.CurrentController.getViewCursor()
   oViewCursor.JumpToPage(iPageCount)
   oText = oDoc.getText()
   oCursor = oText.createTextCursor()
'   oCursor.goToEnd(FALSE)
   oCursor.goToRange( oViewCursor, FALSE )

   REM Create the date and time objects
   DIM oDate AS Object, oTime AS Object
   oDate = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oDate.IsFixed = TRUE
   oDate.IsDate = TRUE
   oDate.NumberFormat = FindCreateNumberFormatStyle("D MMMM JJJJ", oDoc)
   
   oTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oTime.IsFixed = True
   oTime.IsDate = False
   oTime.NumberFormat = FindCreateNumberFormatStyle("UU:MM", oDoc)

   REM Create the frame
   DIM oFrameDT AS Object
   oFrameDT = oDoc.createInstance("com.sun.star.text.TextFrame")
   With oFrameDT
   .setName("FrameDT")
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
   .HoriOrient = com.sun.star.text.HoriOrientation.NONE
   .VertOrient = com.sun.star.text.VertOrientation.NONE
   .HoriOrientPosition = -4200
   .VertOrientPosition = -3500
   .width = 4000
   .height = 1500
   .BorderDistance = 100
   End With

   REM Insert the frame into the text document
   oText.insertTextContent( oCursor, oFrameDT, True )

   REM Write the text inside the frame
   DIM oCursor2 AS Object
   oCursor2 = oFrameDT.createTextCursor()
   With oCursor2
   .charHeight = 13
   .charWeight = com.sun.star.awt.FontWeight.BOLD
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertString( oCursor2, sActionText, False )

   With oCursor2
   .charHeight = 9
   .charWeight = com.sun.star.awt.FontWeight.NORMAL
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oDate, False )

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.LINE_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oTime, False )
End Sub



' ------------------------------
' This macro removes the 'DATE/TIME'-stamp created with
' the previous macro
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub RemoveDTstamp()
   DIM oDoc AS Object, oTextFrames AS Object, oFrameDT AS Object
   oDoc = ThisComponent

   REM Look for the datetimestamp-frame and remove it
   oTextFrames = oDoc.getTextFrames
   If oTextFrames.hasByName("FrameDT") Then
      oFrameDT = oTextFrames.getByName("FrameDT")
      oFrameDT.dispose()
   EndIf
End Sub


' ------------------------------
' This macro returns the content of a certain userinputfield
'
' Written by JohnV @ http://forum.openoffice.org/en/forum/ (2012)
' Adapted slightly by Vincent Van Houtte (2012)
' ------------------------------
Function GetInputUserField( sInputHint AS String )
   DIM oDoc AS Object, enuTF AS Object, aTextField AS Object
   DIM sInputContent AS String
   oDoc = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   enuTF = oDoc.TextFields.createEnumeration
   Do While enuTF.hasMoreElements
      aTextField = enuTF.nextElement
      If aTextField.supportsService("com.sun.star.text.TextField.InputUser") Then
         If aTextField.Content = sInputHint Then
            sInputContent = aTextField.Anchor.String
         EndIf
      Endif
   Loop

   GetInputField = sInputContent
   
'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function

' ------------------------------
' This macro returns the content of a certain inputfield
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Function GetInputField( sInputHint AS String )
   DIM oDoc AS Object, enuTF AS Object, aTextField AS Object
   DIM sInputContent AS String
   oDoc = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   enuTF = oDoc.TextFields.createEnumeration
   Do While enuTF.hasMoreElements
      aTextField = enuTF.nextElement
      If aTextField.supportsService("com.sun.star.text.TextField.Input") Then
         If aTextField.getPropertyValue("Hint") = sInputHint Then
            sInputContent = aTextField.getPropertyValue("Content")
         EndIf
      Endif
   Loop

   GetInputField = sInputContent
   
'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function



REM ** HELPER PRINTING FUNCTIONS **

' ------------------------------
' This macro shows a dialog with a list of all installed printers on your system.
' Ideally, the dialog closes after a selection has been made
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Function ShowListPrinters
   DIM aPrinterNames(10)
   DIM d AS Object, l AS Object, list AS Object, result(10)

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   aPrinterNames = GetAllPrinterNames()

   DialogLibraries.loadLibrary("Standard")
   d = CreateUnoDialog(DialogLibraries.Standard.dlgListPrinters)
      d.setTitle("Selecteer printer")
      l = d.getControl("ListPrinters")
      l.getModel().StringItemList = aPrinterNames
      l.selectItemPos( 0, true )
   d.execute()
      list = d.getModel().getByName("ListPrinters")
      result = list.StringItemList(list.SelectedItems(0))
   d.dispose()
   ShowListPrinters = result

'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function


' ------------------------------
' This macro returns an array with a list of all installed printers. It is possible
' that it doesn't work on older (pre OOo3.5) versions of OOo / LO
'
' Written by Niklas Nebel (cited by Andrew Pitonyak)
' Adapted very slightly by Vincent Van Houtte (2012)
' ------------------------------
Function GetAllPrinterNames()
   DIM oPrintServer AS Object ' The print server service.
   DIM oCore AS Object        ' Get classes and other objects by name.
   DIM oClass AS Object       ' XPrinterServer class object.
   DIM oMethod AS Object      ' getPrinterNames method from the XPrinterServer class.

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   ' Create the object that will not be directly usable until OOo 3.5.
   oPrintServer = CreateUnoService("com.sun.star.awt.PrinterServer")
   oCore = CreateUnoService("com.sun.star.reflection.CoreReflection")

   ' Get the class object for the XPrinterServer interface.
   oClass = oCore.forName("com.sun.star.awt.XPrinterServer")

   ' Get the getPrinterNames method for the XPrinterServer class.
   oMethod = oClass.getMethod("getPrinterNames")

   ' Call the getPrinterNames method on the PrinterServer object.
   GetAllPrinterNames = oMethod.invoke(oPrintServer, Array())

'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function


REM ** HELPER PRINTING MACRO'S **

' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding the pre-printed (first-page-)stationary:
' you can set an image as a background, that you don't want to print,
' but that you want to show up when converted to PDF.
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_stat_first(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray2"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding the pre-printed (other-page-)stationary:
' you can set an image as a background, that you don't want to print,
' but that you want to show up when converted to PDF.
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_stat_rest(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding plain paper, for example to keep in your own file
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_plain(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page with the background(-image) to the
' papertray holding plain paper, for example to keep in your official books
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Sub Print_plain_with_background(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = True
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a specified page given the chosen parameters
'
' Written by Vincent Van Houtte (2010)
' ------------------------------
Sub printPage(sTray AS String, bBg AS Boolean, sPageNr AS String, sPrinter AS String)
   DIM oDoc AS Object
   oDoc = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   REM Set backgroundImage-option in DocumentSettings to False
   DIM oSettings AS Object
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = bBg

   REM Set the chosen printer
   DIM mPrinterOpts(2) AS NEW com.sun.star.beans.PropertyValue
   mPrinterOpts(0).Name = "Name"
   mPrinterOpts(0).Value = sPrinter
   mPrinterOpts(1).Name = "PaperFormat"
   mPrinterOpts(1).Value = com.sun.star.view.PaperFormat.A4
   mPrinterOpts(2).Name = "PaperOrientation"
   mPrinterOpts(2).Value = com.sun.star.view.PaperOrientation.PORTRAIT
   oDoc.Printer = mPrinterOpts()

   REM cast sPageNr as a integer
   DIM iPageNr AS Integer
   iPageNr = sPageNr

   REM set Papertray in Styles
   DIM oStyle AS Object, oViewCursor AS Object, sPageStyleName AS String
   oViewCursor = oDoc.CurrentController.getViewCursor()
   oViewCursor.JumpToPage(iPageNr)
   sPageStyleName = oViewCursor.PageStyleName
   oStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(sPageStyleName)
   'If the printer has but one tray, comment the next line out:
   oStyle.PrinterPaperTray = sTray

   REM Set printOptions
   DIM mPrintOpts(3) AS NEW com.sun.star.beans.PropertyValue
   mPrintOpts(0).Name = "CopyCount"
   mPrintOpts(0).Value = 1
   mPrintOpts(1).Name = "Collate"
   mPrintOpts(1).Value = True
   mPrintOpts(2).Name = "Pages"
   mPrintOpts(2).Value = sPageNr
   mPrintOpts(3).Name = "Wait"
   mPrintOpts(3).Value = True

   REM Print or Debug
'   MsgBox sPageNr + " / " + sPageStyleName
'   Xray oViewCursor
   oDoc.Print(mPrintOpts())

   REM RESET OPTIONS
   REM Set backgroundImage-option in DocumentSettings to True
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = True
'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


REM ** PRINTING MACRO'S ASSIGNED TO BUTTONS**

' ------------------------------
' This macro chooses automatically how the document should be printed,
' based on the value of the inputfield 'verzendingswijze'
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Sub Smart_close()
   DIM oDoc AS Object
   DIM sHow AS String
   oDoc   = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   REM Get content of inputfield
   sHow = GetInputField( "verzendingswijze" )

'Perform action
   Select Case sHow
      Case "per e-mail: ":
         MsgBox "Verzendingswijze: e-mail"
         Mail_close()
      Case "per fax: ":
         MsgBox "Verzendingswijze: fax"
         Fax_close()
      Case "per aangetekende post en per gewone post":
         MsgBox "Verzendingswijze: aangetekende brief"
         Letter_recommended_close()
      Case "":
         MsgBox "Verzendingswijze: gewone brief"
         Letter_close()
      Case Else:
         MsgBox "Verzendingswijze '" + sHow + "' niet gekend - ik doe niks!"
   End Select

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints the document once to stationary and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Fax_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints a copy of the document, sends the
' document to the default email app as a PDF and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Mail_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print copy
   REM Insert timestamp of sending
   sActionText = "VERZONDEN"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Create PDF
   REM Replace .odt with .pdf
   DIM sDocURL AS String, sPDFURL AS String
   sDocURL = oDoc.getURL()
   sPDFURL = Left$(sDocURL,Len(sDocURL)-4) + ".pdf"

   REM Save as PDF
   DIM args(0) AS NEW com.sun.star.beans.PropertyValue
   args(0).Name = "FilterName"
   args(0).Value = "writer_pdf_Export"
   oDoc.storeToURL(sPDFURL,args())

'Send to mailapp
   REM Get the values of the textfields inside the document to form the subject line
   DIM sDosName AS String, sDosNum AS String, sDosUref AS String, sTo AS String, sSubject AS String
   
   sDosName   = GetInputField( "briefBetreft" )
   sDosNum      = GetInputField( "briefOnzeReferte" )
   sDosUref   = GetInputField( "briefUwReferte" )
   sTo         = GetInputField( "verzendingsadres" )
   sSubject   = sDosName + " - " + sDosUref + " - " + sDosNum

   REM Send the PDF as an attachment
   DIM MailClient AS Object, MailAgent AS Object, MailMessage AS Object
   'On linux systems, use SimpleCommandMail
   MailAgent = CreateUnoService("com.sun.star.system.SimpleCommandMail")
   'On windows systems, use SimpleSystemMail
   'MailAgent = CreateUnoService("com.sun.star.system.SimpleSystemMail")
   MailClient = MailAgent.querySimpleMailClient()
      MailMessage=MailClient.createSimpleMailMessage()
      MailMessage.setRecipient(sTo)
      MailMessage.setSubject(sSubject)
      MailMessage.setAttachement(array(sPDFURL))
   MailClient.sendSimpleMailMessage(MailMessage, 0)

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub

' ------------------------------
' This macro prints the document once to stationary, once as a copy and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Letter_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Print copy
   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub

' ------------------------------
' This macro prints the document twice to stationary, once as a copy and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Letter_recommended_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Print stat second
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Print copy
   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints a copy of the document, and makes a
' PDF-doc with copy-stamp
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_copy()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print copy
   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Create PDF
   REM Replace .odt with _cp.pdf
   DIM sDocURL AS String, sPDFURL AS String
   sDocURL = oDoc.getURL()
   sPDFURL = Left$(sDocURL,Len(sDocURL)-4) + "_cp.pdf"

   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Save as PDF
   DIM args(0) AS NEW com.sun.star.beans.PropertyValue
   args(0).Name = "FilterName"
   args(0).Value = "writer_pdf_Export"
   oDoc.storeToURL(sPDFURL,args())

   REM Remove the copystamp-frame
   RemoveDTstamp()

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub
Last edited by zenlord on Fri Oct 19, 2012 12:20 pm, edited 1 time in total.
LibreOffice 4.1 on Linux (Debian Wheezy backports)
zenlord
 
Posts: 51
Joined: Tue Dec 22, 2009 5:50 pm

Re: [BASIC] Advanced printing macro's

Postby zenlord » Fri Oct 19, 2012 12:19 pm

Version 2.2: added a function to automate the choice for the right mailsystem, depending on the operating system:

Code: Select all   Expand viewCollapse view
REM ** VERSIONING **
'Version 2.2 (19 okt 2012)
' I have added a function getOS() to differentiate between windows-computers and other
' ones, to be able to automate the choice between simpleSystemMail and simpleCommandMail
'Version 2.1 (19 okt 2012)
' Thanks To JohnV, I have added new functions to get the contents of (user)inputfields
' and applied them in a new 'Smart_close' -function that chooses
'  automatically, based on the contents of a certain inputfield, how the
'  letter should be printed / sent
'Version 2.0.1 (12 okt 2012)
' Thanks To Bernard Marcelly, I have added explicit declarations everywhere
'  and simplified the loops
'Version 2.0 (11 okt 2012)
' Added simple ErrorHandler and rewrote comments

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

Sub Main
   REM Set backgroundImage-option in DocumentSettings to True
   DIM oDoc AS Object, oSettings AS Object
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = TRUE
End Sub


REM ** GENERAL HELPERS **

' ------------------------------
' This macro displays the operating system on which the macro is run.
' The difference between OSX and UNIX might not be detected correctly
'
' Written by Heertsch
' ( http://forum.openoffice.org/en/forum/viewtopic.php?f=45&t=26280&p=176535&hilit=operating#p137780 )
' ------------------------------
Function getOS() AS String
   Select Case getGUIType
      Case 1: getOS="WINDOWS"
      Case 3: getOS="MAC"
      Case 4: getOS=iif(instr(environ("PATH"),"/usr/local/bin")=0,"OSX","UNIX")
   End Select
End Function


' ------------------------------
' This macro closes the current document
'
' Written by Andrew Pitonyak (2010)
' Adapted by Vincent Van Houtte (2011)
' ------------------------------
Sub closeDocument(oDoc AS Object)
   REM Check if the document exists
   If IsNull(oDoc) Then
      Exit Sub
   End If

   REM Store the document if it was modified
   If (oDoc.isModified) Then
     If (oDoc.hasLocation AND (Not oDoc.isReadOnly)) Then
       oDoc.store()
     Else
       oDoc.setModified(False)
     End If
   End If

   REM Close the document
   oDoc.close(true)
End Sub

' ------------------------------
' Written by Andrew Pitonyak the Great
' Used in the Date-time-functions
' ------------------------------
Function FindCreateNumberFormatStyle ( sFormat As String, Optional doc, Optional locale)
   Dim oDoc As Object
   Dim aLocale As New com.sun.star.lang.Locale
   Dim oFormats As Object
   Dim formatNum As Integer
   oDoc = IIf(IsMissing(doc), ThisComponent, doc)
   oFormats = oDoc.getNumberFormats()
   'If you choose to query on types, you need to use the type
   'com.sun.star.util.NumberFormat.DATE
   'I could set the locale from values stored at
   'http://www.ics.uci.edu/pub/ietf/http/related/iso639.txt
   'http://www.chemie.fu-berlin.de/diverse/doc/ISO_3166.html
   'I use a NULL locale and let it use whatever it likes.
   'First, see if the number format exists
   If ( Not IsMissing(locale)) Then
   aLocale = locale
   End If
   formatNum = oFormats.queryKey (sFormat, aLocale, TRUE)
   'MsgBox "Current Format number is" & formatNum
   'If the number format does not exist then add it
   If (formatNum = -1) Then
   formatNum = oFormats.addNew(sFormat, aLocale)
   If (formatNum = -1) Then formatNum = 0
   '   MsgBox "new Format number is " & formatNum
   End If
   FindCreateNumberFormatStyle = formatNum
End Function


REM ** HELPER MACRO'S TO INSERT / REMOVE A DATESTAMP**

' ------------------------------
' This macro inserts a 'DATE/TIME'-stamp with sActionText
' like 'Printed' or 'Sent'
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub InsertDTstampFirstPage(sActionText AS String)
   DIM oCursor AS Object, oText AS Object, oDoc AS Object
   DIM oViewCursor AS Object
   oDoc = ThisComponent
   
   oViewCursor = oDoc.CurrentController.getViewCursor()
   oViewCursor.JumpToPage(1)
   oText = oDoc.getText()
   oCursor = oText.createTextCursor()
'   oCursor.goToEnd(FALSE)
   oCursor.goToRange( oViewCursor, FALSE )

   REM Create the date and time objects
   DIM oDate AS Object, oTime AS Object
   oDate = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oDate.IsFixed = TRUE
   oDate.IsDate = TRUE
   oDate.NumberFormat = FindCreateNumberFormatStyle("D MMMM JJJJ", oDoc)
   
   oTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oTime.IsFixed = True
   oTime.IsDate = False
   oTime.NumberFormat = FindCreateNumberFormatStyle("UU:MM", oDoc)

   REM Create the frame
   DIM oFrameDT AS Object
   oFrameDT = oDoc.createInstance("com.sun.star.text.TextFrame")
   With oFrameDT
   .setName("FrameDT")
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
   .HoriOrient = com.sun.star.text.HoriOrientation.NONE
   .VertOrient = com.sun.star.text.VertOrientation.NONE
   .HoriOrientPosition = -4200
   .VertOrientPosition = -3500
   .width = 4000
   .height = 1500
   .BorderDistance = 100
   End With

   REM Insert the frame into the text document
   oText.insertTextContent( oCursor, oFrameDT, True )

   REM Write the text inside the frame
   DIM oCursor2 AS Object
   oCursor2 = oFrameDT.createTextCursor()
   With oCursor2
   .charHeight = 13
   .charWeight = com.sun.star.awt.FontWeight.BOLD
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertString( oCursor2, sActionText, False )

   With oCursor2
   .charHeight = 9
   .charWeight = com.sun.star.awt.FontWeight.NORMAL
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oDate, False )

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.LINE_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oTime, False )
End Sub


' ------------------------------
' This macro inserts a 'DATE/TIME'-stamp with sActionText
' like 'Printed', 'Copy', 'Books' or 'Sent'
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Sub InsertDTstampLastPage(sActionText AS String)
   DIM oCursor AS Object, oText AS Object, oDoc AS Object
   DIM oViewCursor AS Object
   DIM iPageCount AS Integer
   oDoc = ThisComponent
   
   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

   REM Position the cursor
   oViewCursor = oDoc.CurrentController.getViewCursor()
   oViewCursor.JumpToPage(iPageCount)
   oText = oDoc.getText()
   oCursor = oText.createTextCursor()
'   oCursor.goToEnd(FALSE)
   oCursor.goToRange( oViewCursor, FALSE )

   REM Create the date and time objects
   DIM oDate AS Object, oTime AS Object
   oDate = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oDate.IsFixed = TRUE
   oDate.IsDate = TRUE
   oDate.NumberFormat = FindCreateNumberFormatStyle("D MMMM JJJJ", oDoc)
   
   oTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
   oTime.IsFixed = True
   oTime.IsDate = False
   oTime.NumberFormat = FindCreateNumberFormatStyle("UU:MM", oDoc)

   REM Create the frame
   DIM oFrameDT AS Object
   oFrameDT = oDoc.createInstance("com.sun.star.text.TextFrame")
   With oFrameDT
   .setName("FrameDT")
   .AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE
   .HoriOrient = com.sun.star.text.HoriOrientation.NONE
   .VertOrient = com.sun.star.text.VertOrientation.NONE
   .HoriOrientPosition = -4200
   .VertOrientPosition = -3500
   .width = 4000
   .height = 1500
   .BorderDistance = 100
   End With

   REM Insert the frame into the text document
   oText.insertTextContent( oCursor, oFrameDT, True )

   REM Write the text inside the frame
   DIM oCursor2 AS Object
   oCursor2 = oFrameDT.createTextCursor()
   With oCursor2
   .charHeight = 13
   .charWeight = com.sun.star.awt.FontWeight.BOLD
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertString( oCursor2, sActionText, False )

   With oCursor2
   .charHeight = 9
   .charWeight = com.sun.star.awt.FontWeight.NORMAL
   .paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
   End With

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oDate, False )

   oFrameDT.insertControlCharacter( oCursor2, com.sun.star.text.ControlCharacter.LINE_BREAK, False )
   oFrameDT.insertTextContent( oCursor2, oTime, False )
End Sub



' ------------------------------
' This macro removes the 'DATE/TIME'-stamp created with
' the previous macro
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub RemoveDTstamp()
   DIM oDoc AS Object, oTextFrames AS Object, oFrameDT AS Object
   oDoc = ThisComponent

   REM Look for the datetimestamp-frame and remove it
   oTextFrames = oDoc.getTextFrames
   If oTextFrames.hasByName("FrameDT") Then
      oFrameDT = oTextFrames.getByName("FrameDT")
      oFrameDT.dispose()
   EndIf
End Sub


' ------------------------------
' This macro returns the content of a certain userinputfield
'
' Written by JohnV @ http://forum.openoffice.org/en/forum/ (2012)
' Adapted slightly by Vincent Van Houtte (2012)
' ------------------------------
Function GetInputUserField( sInputHint AS String )
   DIM oDoc AS Object, enuTF AS Object, aTextField AS Object
   DIM sInputContent AS String
   oDoc = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   enuTF = oDoc.TextFields.createEnumeration
   Do While enuTF.hasMoreElements
      aTextField = enuTF.nextElement
      If aTextField.supportsService("com.sun.star.text.TextField.InputUser") Then
         If aTextField.Content = sInputHint Then
            sInputContent = aTextField.Anchor.String
         EndIf
      Endif
   Loop

   GetInputField = sInputContent
   
'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function

' ------------------------------
' This macro returns the content of a certain inputfield
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Function GetInputField( sInputHint AS String )
   DIM oDoc AS Object, enuTF AS Object, aTextField AS Object
   DIM sInputContent AS String
   oDoc = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   enuTF = oDoc.TextFields.createEnumeration
   Do While enuTF.hasMoreElements
      aTextField = enuTF.nextElement
      If aTextField.supportsService("com.sun.star.text.TextField.Input") Then
         If aTextField.getPropertyValue("Hint") = sInputHint Then
            sInputContent = aTextField.getPropertyValue("Content")
         EndIf
      Endif
   Loop

   GetInputField = sInputContent
   
'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function



REM ** HELPER PRINTING FUNCTIONS **

' ------------------------------
' This macro shows a dialog with a list of all installed printers on your system.
' Ideally, the dialog closes after a selection has been made
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Function ShowListPrinters
   DIM aPrinterNames(10)
   DIM d AS Object, l AS Object, list AS Object, result(10)

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   aPrinterNames = GetAllPrinterNames()

   DialogLibraries.loadLibrary("Standard")
   d = CreateUnoDialog(DialogLibraries.Standard.dlgListPrinters)
      d.setTitle("Selecteer printer")
      l = d.getControl("ListPrinters")
      l.getModel().StringItemList = aPrinterNames
      l.selectItemPos( 0, true )
   d.execute()
      list = d.getModel().getByName("ListPrinters")
      result = list.StringItemList(list.SelectedItems(0))
   d.dispose()
   ShowListPrinters = result

'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function


' ------------------------------
' This macro returns an array with a list of all installed printers. It is possible
' that it doesn't work on older (pre OOo3.5) versions of OOo / LO
'
' Written by Niklas Nebel (cited by Andrew Pitonyak)
' Adapted very slightly by Vincent Van Houtte (2012)
' ------------------------------
Function GetAllPrinterNames()
   DIM oPrintServer AS Object ' The print server service.
   DIM oCore AS Object        ' Get classes and other objects by name.
   DIM oClass AS Object       ' XPrinterServer class object.
   DIM oMethod AS Object      ' getPrinterNames method from the XPrinterServer class.

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   ' Create the object that will not be directly usable until OOo 3.5.
   oPrintServer = CreateUnoService("com.sun.star.awt.PrinterServer")
   oCore = CreateUnoService("com.sun.star.reflection.CoreReflection")

   ' Get the class object for the XPrinterServer interface.
   oClass = oCore.forName("com.sun.star.awt.XPrinterServer")

   ' Get the getPrinterNames method for the XPrinterServer class.
   oMethod = oClass.getMethod("getPrinterNames")

   ' Call the getPrinterNames method on the PrinterServer object.
   GetAllPrinterNames = oMethod.invoke(oPrintServer, Array())

'ErrorHandler
Exit Function
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Function


REM ** HELPER PRINTING MACRO'S **

' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding the pre-printed (first-page-)stationary:
' you can set an image as a background, that you don't want to print,
' but that you want to show up when converted to PDF.
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_stat_first(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray2"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding the pre-printed (other-page-)stationary:
' you can set an image as a background, that you don't want to print,
' but that you want to show up when converted to PDF.
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_stat_rest(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page without the background(-image) to the
' papertray holding plain paper, for example to keep in your own file
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_plain(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = False
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a given page with the background(-image) to the
' papertray holding plain paper, for example to keep in your official books
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Sub Print_plain_with_background(iPageNr AS Integer, sPrinter AS String)
   DIM sTray AS String
   DIM bBg AS Boolean
   sTray = "Tray1"
   bBg = True
   printPage(sTray, bBg, iPageNr, sPrinter)
End Sub


' ------------------------------
' This macro prints a specified page given the chosen parameters
'
' Written by Vincent Van Houtte (2010)
' ------------------------------
Sub printPage(sTray AS String, bBg AS Boolean, sPageNr AS String, sPrinter AS String)
   DIM oDoc AS Object
   oDoc = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   REM Set backgroundImage-option in DocumentSettings to False
   DIM oSettings AS Object
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = bBg

   REM Set the chosen printer
   DIM mPrinterOpts(2) AS NEW com.sun.star.beans.PropertyValue
   mPrinterOpts(0).Name = "Name"
   mPrinterOpts(0).Value = sPrinter
   mPrinterOpts(1).Name = "PaperFormat"
   mPrinterOpts(1).Value = com.sun.star.view.PaperFormat.A4
   mPrinterOpts(2).Name = "PaperOrientation"
   mPrinterOpts(2).Value = com.sun.star.view.PaperOrientation.PORTRAIT
   oDoc.Printer = mPrinterOpts()

   REM cast sPageNr as a integer
   DIM iPageNr AS Integer
   iPageNr = sPageNr

   REM set Papertray in Styles
   DIM oStyle AS Object, oViewCursor AS Object, sPageStyleName AS String
   oViewCursor = oDoc.CurrentController.getViewCursor()
   oViewCursor.JumpToPage(iPageNr)
   sPageStyleName = oViewCursor.PageStyleName
   oStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(sPageStyleName)
   'If the printer has but one tray, comment the next line out:
   oStyle.PrinterPaperTray = sTray

   REM Set printOptions
   DIM mPrintOpts(3) AS NEW com.sun.star.beans.PropertyValue
   mPrintOpts(0).Name = "CopyCount"
   mPrintOpts(0).Value = 1
   mPrintOpts(1).Name = "Collate"
   mPrintOpts(1).Value = True
   mPrintOpts(2).Name = "Pages"
   mPrintOpts(2).Value = sPageNr
   mPrintOpts(3).Name = "Wait"
   mPrintOpts(3).Value = True

   REM Print or Debug
'   MsgBox sPageNr + " / " + sPageStyleName
'   Xray oViewCursor
   oDoc.Print(mPrintOpts())

   REM RESET OPTIONS
   REM Set backgroundImage-option in DocumentSettings to True
   oSettings = oDoc.createInstance("com.sun.star.text.DocumentSettings")
   oSettings.PrintPageBackground = True
'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


REM ** PRINTING MACRO'S ASSIGNED TO BUTTONS**

' ------------------------------
' This macro chooses automatically how the document should be printed,
' based on the value of the inputfield 'verzendingswijze'
'
' Written by Vincent Van Houtte (2012)
' ------------------------------
Sub Smart_close()
   DIM oDoc AS Object
   DIM sHow AS String
   oDoc   = ThisComponent

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   REM Get content of inputfield
   sHow = GetInputField( "verzendingswijze" )

'Perform action
   Select Case sHow
      Case "per e-mail: ":
      '   MsgBox "Verzendingswijze: e-mail"
         Mail_close()
      Case "per fax: ":
      '   MsgBox "Verzendingswijze: fax"
         Fax_close()
      Case "per aangetekende post en per gewone post":
      '   MsgBox "Verzendingswijze: aangetekende brief"
         Letter_recommended_close()
      Case "":
      '   MsgBox "Verzendingswijze: gewone brief"
         Letter_close()
      Case Else:
         MsgBox "Verzendingswijze '" + sHow + "' niet gekend - ik doe niks!"
   End Select

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints the document once to stationary and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Fax_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints a copy of the document, sends the
' document to the default email app as a PDF and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Mail_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print copy
   REM Insert timestamp of sending
   sActionText = "VERZONDEN"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Create PDF
   REM Replace .odt with .pdf
   DIM sDocURL AS String, sPDFURL AS String
   sDocURL = oDoc.getURL()
   sPDFURL = Left$(sDocURL,Len(sDocURL)-4) + ".pdf"

   REM Save as PDF
   DIM args(0) AS NEW com.sun.star.beans.PropertyValue
   args(0).Name = "FilterName"
   args(0).Value = "writer_pdf_Export"
   oDoc.storeToURL(sPDFURL,args())

'Send to mailapp
   REM Get the values of the textfields inside the document to form the subject line
   DIM sDosName AS String, sDosNum AS String, sDosUref AS String, sTo AS String, sSubject AS String
   
   sDosName   = GetInputField( "briefBetreft" )
   sDosNum      = GetInputField( "briefOnzeReferte" )
   sDosUref   = GetInputField( "briefUwReferte" )
   sTo         = GetInputField( "verzendingsadres" )
   sSubject   = sDosName + " - " + sDosUref + " - " + sDosNum

   REM Send the PDF as an attachment
   DIM MailClient AS Object, MailAgent AS Object, MailMessage AS Object
   
   'Define whether SimpleSystemMail or SimpleCommandMail should be used
   Select Case getOS
      Case "WINDOWS": MailAgent = CreateUnoService("com.sun.star.system.SimpleSystemMail")
      Case Else: MailAgent = CreateUnoService("com.sun.star.system.SimpleCommandMail")
   End Select

   'On linux systems, use SimpleCommandMail
   'MailAgent = CreateUnoService("com.sun.star.system.SimpleCommandMail")
   'On windows systems, use SimpleSystemMail
   'MailAgent = CreateUnoService("com.sun.star.system.SimpleSystemMail")
   MailClient = MailAgent.querySimpleMailClient()
      MailMessage=MailClient.createSimpleMailMessage()
      MailMessage.setRecipient(sTo)
      MailMessage.setSubject(sSubject)
      MailMessage.setAttachement(array(sPDFURL))
   MailClient.sendSimpleMailMessage(MailMessage, 0)

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub

' ------------------------------
' This macro prints the document once to stationary, once as a copy and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Letter_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Print copy
   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub

' ------------------------------
' This macro prints the document twice to stationary, once as a copy and exits
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Letter_recommended_close()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print stat
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Print stat second
   REM Print the first page
   Print_stat_first(1, sPrinter)

   REM Loop over every next page and print it
   For n = 2 to iPageCount
      Print_stat_rest(n, sPrinter)
   next

'Print copy
   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Exit
   REM Save and close the document
   closeDocument(oDoc)

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


' ------------------------------
' This macro prints a copy of the document, and makes a
' PDF-doc with copy-stamp
'
' Written by Vincent Van Houtte (2011)
' ------------------------------
Sub Print_copy()
   DIM oDoc AS Object, oCursor AS Object, oText AS Object
   DIM iPageCount AS Integer, n AS Integer
   DIM sPage AS String
   DIM sPrinter AS String
   DIM sActionText AS String

   REM Initiate Errorhandler
   On error GoTo ErrorHandler

   sPrinter= ShowListPrinters()
   oDoc   = ThisComponent

   REM Count the amount of pages
   iPageCount = oDoc.getCurrentController().getPropertyValue("PageCount")

'Print copy
   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Loop over every next page and print it
   For n = 1 to iPageCount
      Print_plain(n, sPrinter)
   next

   REM Remove the copystamp-frame
   RemoveDTstamp()

'Create PDF
   REM Replace .odt with _cp.pdf
   DIM sDocURL AS String, sPDFURL AS String
   sDocURL = oDoc.getURL()
   sPDFURL = Left$(sDocURL,Len(sDocURL)-4) + "_cp.pdf"

   REM Insert timestamp of sending
   sActionText = "KOPIE"
   InsertDTstampFirstPage(sActionText)

   REM Save as PDF
   DIM args(0) AS NEW com.sun.star.beans.PropertyValue
   args(0).Name = "FilterName"
   args(0).Value = "writer_pdf_Export"
   oDoc.storeToURL(sPDFURL,args())

   REM Remove the copystamp-frame
   RemoveDTstamp()

'ErrorHandler
Exit Sub
   ErrorHandler:
   Reset
   MsgBox "Error " & Err & ": " & Error$ + chr(13) + "At line : " + Erl + chr(13) + Now , 16 ,"an error occurred"
End Sub


Next projects:
1. Add hardcoded arrays for all known printers to include information about the availability of multiple trays (since this information cannot be fetched dynamically apparently)
2. Automating fax sending directly from the pc to the faxprinter
3. Center the dialog on screen to chose the printer (low priority)
4. Start testing a completely new range of macro's around PostgreSQL to record timestamps when the document was opened en closed again, in order to generate automated timesheets.
LibreOffice 4.1 on Linux (Debian Wheezy backports)
zenlord
 
Posts: 51
Joined: Tue Dec 22, 2009 5:50 pm


Return to Code Snippets

Who is online

Users browsing this forum: No registered users and 1 guest