User Tools

Site Tools


programming:ooo:ooo

OpenOffice Macro

This is mainly based on the Andrew's Macro Information tutorial and from the OpenOffice Wiki web site.

These macro are tested on OpenOffice 2.4 for windows and on OpenOffice 3.2 Mac OSX version.

You can find the basic api home page listed here or specifically from here

Divers (spreadsheet) Macro

Main

Sub Main
  Dim oDocument As Object
 
  'Récupère le document actif
  oDocument = ThisComponent
 
  If (IsSpreadhsheetDoc(oDocument)) Then
    MsgBox "This is a spreadsheet document"
  Else
    MsgBox "This is NOT a spreadsheet document"
    Exit Sub
  End if
 
  'Call some functions	
  ExampleGetValue(oDocument)
  ExampleSetValue(oDocument)
  ClearDefinedRange(oDocument)
  CalcIsAnythingSelected(oDocument)
 
  MsgBox PrintableAddressOfCell(oDocument)
 
  SelectedCells(oDocument)
 
End Sub

IsSpreadhsheetDoc

Function IsSpreadhsheetDoc(oDoc As Object) As Boolean
  On Local Error GoTo NODOCUMENTTYPE
 
  IsSpreadhsheetDoc =oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument")
 
  NODOCUMENTTYPE:
  If Err <> 0 Then
    IsSpreadhseetDoc = False
 
    Resume GOON
 
    GOON:
  End If
End Function

ExampleGetValue

Sub ExampleGetValue(oDoc As Object)
  Dim oSheet As Object, oCell As Object
 
  oSheet=oDoc.Sheets.getByName("Sheet1")
  oCell=oSheet.getCellByposition(0,0) 'A1
  print oCell.getValue	'A Number
  'print oCell.getString	'A String
  'print oCell.getFormula	'A Formula
End sub

ExampleSetValue

Sub ExampleSetValue(oDoc As Object)
  Dim oSheet As Object, oCell As Object
  oSheet=oDoc.Sheets.getByName("Sheet1")
  oCell=oSheet.getCellByPosition(1,0) 'B1
  oCell.setValue(23658)
  'oCell..NumberFormat=2 '23658.00
  'oCell.SetString("Oups")
  'oCell.setFormula("=FUNCTION()")
  'oCell.IsCellBackgroundTransparent = TRUE
  oCell.CellBackColor = RGB(255,141,56)
End Sub

ClearDefinedRange

Sub ClearDefinedRange(oDoc As Object)
  Dim oSheet As Object, oSheets As Object
  Dim oCellRange As Object
  Dim nSheets As Long
 
  oSheets = oDoc.Sheets
  nSheets = oDoc.Sheets.Count
 
  'la plage va de 0 à n-1 (Sheet1...)
  oSheet = oSheets.getByIndex(0) 
  oCellRange = oSheet.getCellRangeByName("C6:C9")
  oCellRange.clearContents(_
    com.sun.star.sheet.CellFlags.VALUE + _
    com.sun.star.sheet.CellFlags.DATETIME + _
    com.sun.star.sheet.CellFlags.STRING + _
    com.sun.star.sheet.CellFlags.ANNOTATION + _
    com.sun.star.sheet.CellFlags.FORMULA + _
    com.sun.star.sheet.CellFlags.HARDATTR + _
    com.sun.star.sheet.CellFlags.STYLES + _
    com.sun.star.sheet.CellFlags.OBJECTS + _
    com.sun.star.sheet.CellFlags.EDITATTR )
End Sub

CalcIsAnythingSelected

Function CalcIsAnythingSelected(oDoc As Object) As Boolean
  Dim oSelections As Object, oSel As Object, oText As Object, oCursor As Object
 
  'Initialisation
  IsAnythingSelected = False 
 
  'Pas de document, alors je quitte
  If IsNull(oDoc) Then
    Exit Function 
 
  oSelections = oDoc.getCurrentSelection()
 
  'Pas de selection, alors je quitte
  If IsNull(oSelections) Then 
    Exit Function 
 
  If oSelections.supportsService("com.sun.star.sheet.SheetCell") Then
    Print "Une Cellule sélectionnée = " & oSelections.getImplementationName()
    MsgBox "getString() = " & oSelections.getString()
  ElseIf oSelections.supportsService("com.sun.star.sheet.SheetCellRange") Then
    Print "Une plage de cellules sélectionnée = " & oSelections.getImplementationName()
  ElseIf oSelections.supportsService("com.sun.star.sheet.SheetCellRanges") Then
    Print "Plusieurs plages de cellules sélectionnées = " & oSelections.getImplementationName()
    Print "Count = " & oSelections.getCount()
  Else
    Print "Autre sélection = " & oSelections.getImplementationName()
  End If
End Function

PrintableAddressOfCell

Function PrintableAddressOfCell(oDoc As Object) As String
  Dim oSheet As Object, oCell As Object
  oSheet=oDoc.Sheets.getByName("Sheet1")
  oCell=oSheet.getCellByPosition(1,0) 'B1
 
  PrintableAddressOfCell = "Unknown"
  If Not IsNull(oCell) Then
    PrintableAddressOfCell = oCell.getSpreadSheet().getName + ":" + _
    ColumnNumberToString(oCell.CellAddress.Column) + (oCell.CellAddress.Row+1)
  End If
End Function

ColumnNumberToString

' Les colonnes sont comptées en partant de 0 où 0 correspond à A
' Elles vont de A à Z, puis AA à AZ,BA à BZ,...,jusqu'à IV
' Il s'agit donc essentiellement de la façon de convertir un nombre en base 10 en un nombre
' en base 26.
' Notez que la colonne est passée en valeur (ByVal) !
Function ColumnNumberToString(ByVal the_column As Long) As String
  Dim s$
 
  'Enregistrez le paramètre dans une variable pour NE PAS le changer.
  'C'est un sale bug que j'ai mis du temps à trouver
  Do
    s$ = Chr(65 + the_column MOD 26) + s$
    the_column = the_column / 26
  Loop Until the_column = 0
 
  ColumnNumberToString = s$
End Function

SelectedCells

Sub SelectedCells(oDoc As Object)
  Dim oSelect As Object, oSelectColumn As Object, oSelectRow As Object
  Dim countColumn As Integer, countRow As Integer, noCell As Integer
  Dim oSelectSC As String, oSelectEC As String, oSelectSR As String, oSelectER As String
 
  oSelect=oDoc.CurrentSelection.getRangeAddress
  oSelectColumn=oDoc.CurrentSelection.Columns
  oSelectRow=oDoc.CurrentSelection.Rows
 
  countColumn=oSelectColumn.getCount
  countRow=oSelectRow.getCount
 
  oSelectSC=oSelectColumn.getByIndex(0).getName
  oSelectEC=oSelectColumn.getByIndex(CountColumn-1).getName
  oSelectSR=oSelect.StartRow+1
  oSelectER=oSelect.EndRow+1
  noCell=(CountColumn*CountRow)
 
  If countColumn=1 AND countRow=1 Then
    MsgBox("Cellule " + oSelectSC + oSelectSR + chr(13) + "Nb Cellules = " + noCell + " Cellules Sélectionnées")
  Else
    MsgBox("Plage(" + oSelectSC + oSelectSR + ":" + oSelectEC + oSelectER + ")" + chr(13) + "Nb Cellules = " + noCell + " Cellules Sélectionnées")
  End If
End Sub

createWriterDoc

From http://www.linux.com/archive/feed/37138

Sub createWriterDoc
dim oDesktop as Object
dim sURL as String
dim mNoArgs()
 
oDesktop = createUnoService("com.sun.star.frame.Desktop")
sURL = "private:factory/swriter"
oDesktop.loadComponentFromURL(sURL, "_blank",0,mNoArgs())
 
End Sub

createGraphInCalc

From http://wiki.services.openoffice.org/wiki/Documentation/BASIC_Guide/Structure_of_Charts

Sub createGraphInCalc
Dim Doc As Object
Dim Charts As Object
Dim Chart as Object
Dim Rect As New com.sun.star.awt.Rectangle
Dim RangeAddress(0) As New com.sun.star.table.CellRangeAddress
 
Rect.X = 8000
Rect.Y = 1000
Rect.Width = 10000
Rect.Height = 7000
RangeAddress(0).Sheet = 0
RangeAddress(0).StartColumn = 0 
RangeAddress(0).StartRow = 0
RangeAddress(0).EndColumn = 2
RangeAddress(0).EndRow = 12
 
Doc = ThisComponent
 
Charts = Doc.Sheets(0).Charts
Charts.addNewByName("MyChart", Rect, RangeAddress(), True, True)
Chart = Charts.getByName("MyChart").EmbeddedObject
Chart.HasMainTitle = True
Chart.Title.String = "Main Title String"
Chart.HasSubTitle = True
Chart.Subtitle.String = "Subtitle String"
Chart.HasLegend = True 
Chart.Legend.Alignment = com.sun.star.chart.ChartLegendPosition.BOTTOM
Chart.Legend.FillStyle = com.sun.star.drawing.FillStyle.SOLID
Chart.Legend.FillColor = RGB(210, 210, 210)
Chart.Legend.CharHeight = 7
End Sub

Dialogue

The private global variable

'private, module-wide variable
Private oDialog as Variant

firstDialog

Sub firstDialog()
  ShowDialog("myDialog")
End Sub

ShowDialog

Sub ShowDialog(sDialogName as String)
  Dim oLibContainer As Object, oLib As Object
  Dim oInputStreamProvider As Object
  Const sLibName = "Standard"
 
  MsgBox "Example Starting..."
 
  'library container
  oLibContainer = DialogLibraries
 
  'load the library
  oLibContainer.loadLibrary( sLibName )
 
  'get library
  oLib = oLibContainer.getByName( sLibName )
 
  'get input stream provider
  oInputStreamProvider = oLib.getByName( sDialogName )
 
  'create dialog control
  oDialog = CreateUnoDialog( oInputStreamProvider )
 
  'Do some initializations here if necessary. Here for example, a scrollbar configuration.    
  oScrollBarModel = oDialog.Model.ScrollBar1
  oScrollBarModel.ScrollValueMax = 100
  oScrollBarModel.BlockIncrement = 20
  oScrollBarModel.LineIncrement = 5
  oScrollBarModel.VisibleSize = 20
 
  'show the dialog
  Select Case oDialog.execute()
    Case 1
      MsgBox "Ok pressed"
    Case 0 
      MsgBox "Cancel pressed"
      oDialog.endExecute()
  End Select
 
  'Release the resources used by the program
  oDialog.dispose()
 
End Sub

fillBox

Sub fillBox
  Dim oCellListe as object
  Dim oComboBox as object
  Dim oZoneListe as object, oSheetListe as object
  Dim oCoordListe as object
  Dim aListe() 'un tableau vide
  Dim i , j , endJ, found as integer
 
  oSheetListe = thisComponent.sheets.getByName("Sheet2")'nom de la feuille contenant la liste (à adapter)
  oZoneListe = oSheetListe.getCellRangeByName("myList") 'nom de la liste à charger dans le Combo (à adapter)
  oCoordListe = oZoneListe.RangeAddress ' On récupère les coordonnées de la liste
 
  'On redimenssionne le tableau avec les valeurs MIN et MAX en partant de zéro
  redim aListe(0 to oCoordListe.endRow-oCoordListe.startRow) 		
 
  endJ=0
 
  'On fait une boucle qui parcourt chaque cellule de la liste et stocke dans aListe la valeur
  For i = oCoordListe.startRow To oCoordListe.endRow
    oCellListe = oSheetListe.getCellByPosition(oCoordListe.startColumn, i)
 
    found=0
    For j = 0 To endJ
      If aListe(j) = oCellListe.formula Then
        found=1
        Exit for
      End If
    Next j
 
    If found = 0 Then
      endJ = endJ+1
      aListe(endJ) = oCellListe.formula
    End If
 
  Next i
 
  oComboBox = oDialog.getControl("ComboBox1")
  oComboBox.addItems(aListe(),0)
 
End Sub

AdjustmentHandler

Sub AdjustmentHandler()
  Dim oLabelModel As Object
  Dim oScrollBarModel As Object
  Dim ScrollValue As Long, ScrollValueMax As Long
  Dim VisibleSize As Long
  Dim Factor As Double
  Static bInit As Boolean
  Static PositionX0 As Long
  Static Offset As Long
 
  'get the model of the label control
  oLabelModel = oDialog.Model.Label1
  'oLabelModel = oDialog.Model.FrameControl1
 
  'on initialization remember the position of the label control and calculate offset
  If bInit = False Then
    bInit = True
    PositionX0 = oLabelModel.PositionX
    OffSet = PositionX0 + oLabelModel.Width - (oDialog.Model.Width - Border)
  End If
 
  'get the model of the scroll bar control
  oScrollBarModel = oDialog.Model.ScrollBar1
 
  'get the actual scroll value
  ScrollValue = oScrollBarModel.ScrollValue
 
  'calculate and set new position of the label control
  ScrollValueMax = oScrollBarModel.ScrollValueMax
  VisibleSize = oScrollBarModel.VisibleSize
  Factor = Offset / (ScrollValueMax - VisibleSize)
  oLabelModel.PositionX = PositionX0 - Factor * ScrollValue
End Sub

addToDB

Sub addToDB
  Dim oTextBox As Object
  Dim oDocument As Object, oSheet As Object, oCell As Object
 
  'Récupère le document actif
  oDocument = ThisComponent         
 
  If (IsSpreadhsheetDoc(oDocument)) Then
    MsgBox "This is a spreadsheet document"
  Else
    MsgBox "This is NOT a spreadsheet document"
    Exit Sub
  End if
 
  oSheet=oDocument.Sheets.getByName("Sheet3")
  oCell=oSheet.getCellByPosition(0,0) 'A1
 
  oTextBox = oDialog.getControl("TextField1")
 
  oCell.string=oTextBox.getText
 
  oDialog.Model.Label1.label="Merci"
  oDialog.Model.Label1.TextColor=900
End Sub

copyField

Sub copyField
  Dim oComboBox as object, oTextoBox as object
 
  oComboBox = oDialog.getControl("ComboBox1")
  oTextBox = oDialog.getControl("TextField1")
 
  MsgBox(oComboBox.Text)
  oTextBox.Text=oComboBox.Text
End Sub

nextStep

Sub nextStep
  MsgBox("Go to step "+(oDialog.Model.step+1))
  oDialog.Model.step=oDialog.Model.step+1
End Sub

changeDialog

Sub changeDialog
  MsgBox("Move to another dialog")
  oDialog.endExecute()
  ShowDialog("Dialog1")
End Sub

openWriterDocument

Sub openWriterFiles()
  Dim fileName as String
  Dim oDoc as Object
  Dim FileProperties(0) As New com.sun.star.beans.PropertyValue 'Empty array
 
  'redim FileProperties(0 to 2)
 
  'Fill something in args
  FileProperties(0).name="Preview"
  FileProperties(0).value=true
 
  'Open an existing document
  URL=""
  fileName = "/Users/sbolay/template.odt"
 
  If fileName <> "" Then
    URL=ConvertToURL(fileName)
  Else
    'Create a new document
    URL="private:factory/swriter"
  End If
 
  If fileName <> "" Then
    If not FileExists(fileName) Then
      Msgbox("File " & fileName & " does not exist.", 64, "Error")
      exit sub
    End If
  End If
 
  ' open document in OpenOffice
  oDoc = StarDesktop.loadComponentFromURL(URL, "_blank",0,FileProperties())
 
  if not isnull(oDoc) then
    'do something
 
    'save and close
    'oDoc.Store
    'oDoc.Dispose
  end if
 
End Sub

some Writers macro

Does work only if one form already exists on the document!!

Private oDoc as Variant
Private oForm as Variant
 
Sub Main
InsertCheckbox
test
End Sub
 
Sub InsertCheckbox() 
	Dim oDoc as Any 
	DIm oForm as Any 
	Dim oText as Object, oViewCursor as Object 
	DIm aPoint as New com.sun.star.awt.Point 
	DIm aSize as New com.sun.star.awt.Size 
	Dim aControl as Object 
	Dim oControl as Object 
	Dim oDesktop as Object, oFrame as Object, oCursor as Object 
	Dim iPrint as Integer 
	Dim sTmp1 as String 
	on local Error Goto ErrorHandler 
 
	oDoc = ThisComponent
	'oDoc = StarDesktop.CurrentComponent
 
	If oDoc.DrawPage.Forms.Count > 0 then 
		oForm = oDoc.DrawPage.Forms(0) 
	End if
 
	oViewCursor = oDoc.CurrentController.GetViewCursor 
	oText = oDoc.Text 
 
	aSize.Height = 400 
	aSize.Width = 2500 
	aPoint.x = 2000 
	aPoint.y = oViewCursor.Position.Y+1550 
	sTmp1 = GetNameOfCheckBox() 
 
	aControl = oDoc.CreateInstance ("com.sun.star.form.component.CheckBox") 
	aControl.Label = " "
	aControl.Printable = False 
	oForm.InsertByIndex(oForm.Count,aControl) 
	oControl = Insertcontrol(aControl,oDoc, aPoint, aSize, 2) 
 
	oControl.Control.Name = sTmp1 
	oControl.Control.Label = " " 
	' oControl.PositionProtected = True 
	oControl.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH 
	aPoint = oControl.Position 
	oDoc.TextFields.Refresh 
	Exit Sub 
 
	ErrorHandler: 
	MsgBox Error & " in line " & erl 
 
End Sub
 
Function InsertControl (aControlObject as object, aDoc as Object, aPoint as Object, aSize as Object,iAnchor as Integer) 
	dim aDPage, aShape as object 
	on local Error Goto ErrorHandler 
 
	aShape = aDoc.CreateInstance ("com.sun.star.drawing.ControlShape") 
	aShape.Size = aSize 
	aShape.Position = aPoint 
	aShape.AnchorType = iAnchor 
	aShape.control = aControlObject 
	aDPage = aDoc.drawpage 
	aDPage.Add (aShape) 
	InsertControl = aShape 
	Exit Function 
 
	ErrorHandler: 
	MsgBox Error & " in line " & erl 
 
End Function 
 
Function GetNameOfCheckBox() as String 
	Dim iPos as Integer, iCount as Integer, aPosY as Long 
	on local Error Goto ErrorHandler 
	oDoc = ThisComponent
	'oForm = oDoc.DrawPage.Forms(0)
	oForm = oDoc.DrawPage.Forms.GetByIndex(0)
 
	For iPos = 0 To oForm.Count -1
		oControl = oForm.GetByIndex(iPos) 
		If oControl.ClassID = 5 And Left(oControl.Name,9) = "Check Box" Then 
			iCount = iCount + 1 
		end If 
	next 
 
	GetNameOfCheckBox= "Check Box " & CStr(iCount+1) 
	Exit Function 
 
	ErrorHandler: 
	MsgBox Error & " in line " & erl 
 
End Function
 
sub test
Dim Doc As Object
Dim Form As Object
Dim Ctl As Object
 
Doc = ThisComponent
Form = Doc.DrawPage.Forms.GetByIndex(0)
Ctl = Form.getByName("Text Box 1")
Ctl.Text="test 1"
 
Ctl = Form.getByName("Check Box 1")
Ctl.label=Ctl.label+" ...suite"
Ctl.enabled=1
Ctl.state=1
 
end sub
programming/ooo/ooo.txt · Last modified: 2011/08/15 20:49 by sbolay