FAQ LibreOffice et Apache OpenOfficeConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim oDoc As Object , Feuille As Object 
Dim Cellule As Object 
  
oDoc = ThisComponent 
Feuille = oDoc.getSheets.getByName("Feuille1") 
  
'------- 
'Identification par l'adresse de la cellule (A5) 
Cellule = Feuille.getCellRangeByName("A5") 
  
'------ 
'Identification par la position dans la feuille 
'Attention: le format est getCellByPosition( NumeroColonne , NumeroLigne ) 
'Exemple cellule A5: 
Cellule = Feuille.getCellByPosition( 0 , 4 )

1
2
3
4
5
6
7
8
9
Sub IdentifierCelluleActive 
  Dim CelluleActive As Object 
  
  CelluleActive = ThisComponent.getCurrentSelection 
  
  MsgBox "Index colonne: " & CelluleActive.CellAddress.Column 
  MsgBox "Index ligne: "  & CelluleActive.CellAddress.Row 
  MsgBox "Index feuille: " & CelluleActive.CellAddress.Sheet 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub ControlerContenuCellule 
Dim oDoc As Object , Feuille As Object 
Dim Cellule As Object 
  
oDoc = ThisComponent 
Feuille = oDoc.getSheets.getByName("Feuille1") 
  
Cellule = Feuille.getCellRangeByName("A5") 
  
Select Case Cellule.Type 
  Case com.sun.star.table.CellContentType.VALUE 
    MsgBox "Numérique:"  & Chr(13) & Cellule.Value 
  
  Case com.sun.star.table.CellContentType.TEXT 
    MsgBox "Texte:" & Chr(13) & Cellule.getString  
  
  Case com.sun.star.table.CellContentType.FORMULA 
    MsgBox "Formule" 
  
  Case com.sun.star.table.CellContentType.EMPTY 
    Msgbox "Vide" 
End Select 
  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub EcrireDansCellule 
Dim oDoc As Object , Feuille As Object 
Dim Cellule As Object 
  
oDoc = ThisComponent 
Feuille = oDoc.getSheets.getByName("Feuille1") 
  
'Ecrit valeur numérique 
Cellule = Feuille.getCellRangeByName("A5") 
Cellule.Value = 12345 
  
Cellule = Feuille.getCellRangeByName("A6") 
Cellule.setValue(12345) 
  
'Ecrit du texte 
Cellule = Feuille.getCellRangeByName("A7") 
Cellule.setString("essai") 
  
Cellule = Feuille.getCellRangeByName("A8") 
Cellule.String = "essai" 
  
'Ecrit une Date 
Cellule = Feuille.getCellRangeByName("A9") 
With Cellule 
  .Value = Now 'Insère la date du jour 
  .NumberFormat = 75 
  'D'autres valeurs pour NumberFormat: 
    '34 mois 
    '35 trimestre 
    '40 heure 
    '50 date et heure  
    '79 date en toutes lettres 
    '80 date type 15 sept. 2006 
    '81 date type 15 Juin 2006 
    '85 numéro de semaine    
End With 
  
Cellule = Feuille.getCellRangeByName("A10") 
Cellule.Value = DateValue("26/05/2006")  
  
Cellule = Feuille.getCellRangeByName("A11") 
Cellule.Value = CDate("26/05/2006") 
  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub InsererFormuleParMacro 
Dim oDoc As Object , Feuille As Object 
Dim Cellule As Object 
  
oDoc = ThisComponent 
Feuille = oDoc.getSheets.getByName("Feuille1") 
  
Cellule = Feuille.getCellRangeByName("B1") 
'Ecrit la formule en utilisant le langage de la version OOo installée 
Cellule.FormulaLocal = "=SOMME(A1:A10)" 
  
Cellule = Feuille.getCellRangeByName("B2") 
'Ecrit la formule en utilisant l'anglais 
Cellule.Formula = "=SUM(A1:A10)" 
  
'--- 
'Lit la formule contenue dans la cellule B2 
MsgBox Cellule.Formula & Chr(13) & Cellule.FormulaLocal 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub SupprimeContenuCellule  
Dim oDoc As Object , Feuille As Object 
Dim Cellule As Object 
  
oDoc = ThisComponent 
Feuille = oDoc.getSheets.getByName("Feuille1") 
  
Cellule = Feuille.getCellByPosition( 0 , 4 ) 
  
Cellule.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) 
  
'Description du contenu supprimé: 
'------------------------------- 
'com.sun.star.sheet.CellFlags.VALUE: Valeurs numériques 
'com.sun.star.sheet.CellFlags.DATETIME: Dates et Heures 
'com.sun.star.sheet.CellFlags.STRING: Texte 
'com.sun.star.sheet.CellFlags.ANNOTATION: Annotations(Commentaires) 
'com.sun.star.sheet.CellFlags.FORMULA: Formules 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
'NomFeuille: spécifie la feuille contenant la plage à tester.  
  
'Définition de la plage à tester:  
     'ColDebut: Numéro de la 1ere colonne dans la plage à contrôler  
     ''ColFin: Numéro de la derniere colonne dans la plage à contrôler  
     LigDebut: Numéro de la 1ere ligne dans la plage à contrôler  
     'LigFin: Numéro de la derniere ligne dans la plage à contrôler  
  
'Blancs: Compte les cellules vides si l'argument = true    
  
Function NbDiff_OOo(NomFeuille As String, ColDebut As Integer, _  
   ColFin As Integer, LigDebut As Integer, LigFin As Integer, Blancs As Boolean) As Integer  
  
Dim Ws As Object, Cellule As Object  
Dim Resultat As Variant  
Dim Tableau()  
Dim J As Integer, K As Integer  
  
Ws = ThisComponent.Sheets(NomFeuille)  
NbDiff_OOo = 0  
K = 1  
  
For X = ColDebut - 1 To Colfin - 1  
  For Y = LigDebut - 1  To LigFin - 1  
    Verif = False  
    Cellule = Ws.getCellByposition( X , Y )  
  
    Resultat = Cellule.getString  
  
    If Blancs <> False Or Cellule.Type <> com.sun.star.table.CellContentType.EMPTY Then  
  
      If UBound( Tableau ) = -1 Then  
        ReDim Preserve Tableau(1)  
        Tableau(1) = Resultat  
      Else  
        For J = LBound( Tableau ) To UBound( Tableau )     
          If Tableau( J ) = Resultat Then  
            Verif = True  
            Exit For  
          End If  
        Next J  
  
        If Verif = False Then  
          K = K + 1  
          ReDim Preserve Tableau(K)       
          Tableau(K) = Resultat       
        End If  
  
      End If  
    End If  
  
  Next Y  
Next X  
  
NbDiff_OOo = UBound( Tableau )  
End Function

1
2
3
4
Sub Test 
'Exemple: Plage A1:A10 dans le Feuille1  
MsgBox NbDiff_OOo("Feuille1" ,1 ,1 ,1 ,10 ,True )  
End Sub

=NbDiff_OOo("Feuille1";1;1;1;10;Vrai)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub PlageUtilisee  
  Dim Feuille As Object, Curseur As Object 
  Dim Cible As Object 
  
  'Spécifie la 2eme feuille du classeur  
  Feuille = ThisComponent.Sheets.getByIndex(1)  
  
  Curseur = Feuille.createCursor() 
  
   Curseur.gotoStartOfUsedArea(False)  
   Curseur.gotoEndOfUsedArea(True)  
   Cible = Curseur.getRangeAddress()  
  
   MsgBox "Première ligne: " & Cible.StartRow + 1 & CHR(10) & _ 
     "Première colonne: " & Cible.StartColumn + 1 & CHR(10) & _ 
     "Dernière ligne: " & Cible.EndRow + 1 & CHR(10) & _ 
     "Dernière colonne: " & Cible.EndColumn + 1 
End Sub

1
2
3
4
5
6
7
8
9
10
Sub DerniereLigneNonVide 
Dim oCurseur As Object 
  
'Définit la 1ere feuille 
oCurseur = ThisComponent.Sheets(0).createCursor  
oCurseur.gotoEndOfUsedArea( False ) 
  
'L'index de la première ligne = 0  
MsgBox oCurseur.RangeAddress.EndRow 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub InsertionLienHyperTexteCellule 
  Dim Cellule As Object , ChampURL As Object 
  Dim oTexte As Object 
  
  'Spécifie la cellule A1 dans la 1ere Feuille  
  Cellule = ThisComponent.Sheets(0).GetCellByPosition(0,0)  
  
  ChampURL = _ 
    ThisComponent.createInstance("com.sun.star.text.TextField.URL")  
  
  'Définit le texte qui va s'afficher dans la cellule 
  ChampURL.Representation = "La Description"  
  'Définit le lien 
  ChampURL.URL = "http://www.developpez.com" 
  
  oTexte = Cellule.getText("")  
  'Insertion du lien 
  oTexte.insertTextContent(oTexte.createTextCursor(), ChampURL, False)  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub ExtraireLiensCellule 
  'Nota: 
  'Une même cellule peut contenir plusieurs liens. 
  
  Dim Cellule As Object , oTextfields As Object 
  Dim i As Integer 
  
  'Spécifie la cellule A1 dans la 1ere Feuille  
  Cellule = ThisComponent.Sheets(0).GetCellByPosition(0,0) 
  
  oTextfields = Cellule.TextFields  
  
  'Vérifie s'il y a des liens dans la cellule 
  If oTextfields.Count = 0 Then 
    MsgBox "Il n'y a pas de lien dans la cellule." 
    Exit Sub   
  End If 
  
  'Boucle sur les liens contenus dans la cellule 
  For i = 0 To oTextfields.Count - 1  
  
    'URL= le lien 
    'Representation = la description    
    MsgBox ConvertFromURL(oTextFields.getByIndex( i ).Url) & _ 
      Chr(10) & oTextFields.getByIndex( i ).Representation 
  
  Next i  
  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub ModifierDescriptionLienCellule 
  Dim Cellule As Object , oTextfields As Object 
  
  'Spécifie la cellule A1 dans la 1ere Feuille  
  Cellule = ThisComponent.Sheets(0).GetCellByPosition(0,0) 
  
  oTextfields = Cellule.TextFields  
  
  'Vérifie s'il y a des liens dans la cellule 
  If oTextfields.Count = 0 Then 
    MsgBox "Il n'y a pas de lien dans la cellule." 
    Exit Sub   
  End If 
  
  'Modifie la description. 
  'oTextFields(0) correspond au 1er lien dans la cellule. 
  oTextFields(0).Representation = "La nouvelle description" 
  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub SelectionCellule_Puis_Collage 
  Dim oCC As Object , Cellule As Object 
  Dim Args() As New com.sun.star.beans.PropertyValue  
  
  'Selection cellule C2 
  oCC = ThisComponent.CurrentController  
  Cellule = oCC.ActiveSheet.getCellRangeByName("C2")  
  oCC.Select(Cellule)  
  
  'Collage 
  Dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") 
  Dispatcher.executeDispatch(oCC.Frame, ".uno:Paste", "", 0, Args) 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub BouclePlageCellules 
  Dim Feuille As Object, PlageCellules As Object 
  Dim Plages As Object, oEnum As Object, Cellule As Object 
  
  'Définit une feuille nommée "Feuille1" dans le classeur 
  Feuille = ThisComponent.Sheets.getByName("Feuille1")  
  'Définit la plage de cellules 
  PlageCellules = Feuille.getCellRangeByName("A1:A5") 
  
  Plages = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")  
  Plages.insertByName("", PlageCellules) 
  oEnum = Plages.Cells.CreateEnumeration  
  
  'Boucle sur la plage 
  While oEnum.hasMoreElements  
    'Nota: 
    'Ne renvoie rien si la cellule est vide 
    Cellule = oEnum.NextElement  
    MsgBox Cellule.String  
  Wend  
  
End Sub

1
2
3
4
5
6
7
8
9
10
Sub FusionnerPlageCellules 
  Dim Feuille As Object 
  Dim Plage As Object 
  
  Feuille = ThisComponent.Sheets.getByIndex(0)   
  Plage = Feuille.getCellRangeByPosition( 3 , 9 , 6 , 9 ) 'D10:G10 
  Plage.Merge( True ) 
  
  Feuille.getCellByPosition( 3 ,9 ).setString("test") 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub Transfert_PlageCellulesCalc_Vers_Writer 
  Dim oDesktop As Object , oDoc As Object , oText As Object , oCursor As Object 
  Dim Fichier As String , Resultat As String 
  Dim Args() , Opt()  
  Dim Feuille As Object, PlageCellules As Object 
  Dim Plages As Object, oEnum As Object, Cellule As Object 
  
  
  oDesktop = createUnoService("com.sun.star.frame.Desktop") 
  'Définit le type de document à créer  
  Fichier = "private:factory/swriter" 
  'Création du nouveau fichier Traitement de texte 
  oDoc = oDesktop.LoadComponentFromURL(Fichier, "_blank", 0, Args()) 
  
  
  'Définit une feuille nommée "Feuille1" dans le classeur 
  Feuille = ThisComponent.Sheets.getByName("Feuille1")  
  'Définit la plage de cellules 
  PlageCellules = Feuille.getCellRangeByName("A1:A5") 
  
  Plages = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")  
  Plages.insertByName("", PlageCellules) 
  oEnum = Plages.Cells.CreateEnumeration  
  
  'Boucle sur la plage de cellules à copier 
  While oEnum.hasMoreElements  
    'Nota: 
    'Ne renvoie rien si la cellule est vide 
    Cellule = oEnum.NextElement 
    Resultat = Resultat & Cellule.String & Chr(10) 
  Wend  
  
  
  oText = oDoc.CurrentController.ViewCursor.Text 
  oCursor = oText.createTextCursor 
  'Insertion des données dans le document Traitement de texte 
  oText.insertString oCursor, Resultat , False 
  
  
  'Enregistrement du fichier 
  'oDoc.StoreAsURL ( ConvertToURL("C:\monFichier.odt") , Opt()) 
  
  'Fermeture du fichier  
  'True indique que l'on sauvegarde les modifications éventuelles  
  'oDoc.Close( True ) 
End Sub

ThisComponent.Sheets(0).Columns(1).OptimalWidth = True

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
'--- Source ---  
'http://hermione.s41.xrea.com/pukiwiki/pukiwiki.php?OOobbs2%2F1  
'-------------- 
  
Global oSelectionChangeListener As Object  
Public oController As Object  
  
  
'Lance le gestionnaire d'évènements  
Sub Add_SelectionChangeListener()  
  oController = ThisComponent.CurrentController  
  
  'Objet pour gérer l'événement SelectionChange  
  oSelectionChangeListener = CreateUnoListener( _ 
      "SelectionChange_", "com.sun.star.view.XSelectionChangeListener" )  
  'Attribue l'objet évènement au classeur  
  oController.addSelectionChangeListener( oSelectionChangeListener )  
End Sub  
  
  
Sub Remove_SelectionChangeListener()  
  oController = ThisComponent.CurrentController  
  oController.removeSelectionChangeListener( oSelectionChangeListener )  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Sub SelectionChange_selectionChanged( evt )  
  Dim obj As Object , Cellule As Object  
  Dim tc As Integer , NumFeuille As Integer  
  Dim tr As Long  
  
  obj = evt.Source.Selection  
  
  If obj.ImplementationName = "ScCellObj" Then  
  
    tr = obj.CellAddress.Row  
    tc = obj.CellAddress.Column  
    NumFeuille = evt.source.Selection.RangeAddress.Sheet  
  
   'Vérifie si la sélection est effectuée dans la 1ere feuille du classeur  
   If NumFeuille = 0 Then  
      'Vérifie si la sélection est effectuée dans les colonnes F à J       
       If tc >= 5 And tc <= 9 Then  
  
            Cellule = ThisComponent.getSheets.getByIndex( NumFeuille ). _ 
               getCellByPosition( tc , tr )     
  
            If Cellule.getString = "" Then  
               Cellule.setValue(1)  
               Else  
               Cellule.setString("")  
            End If         
  
         ThisComponent.CurrentController.select( obj.SpreadSheet.getCellByPosition( 0, tr + 1 ) )  
  
         oFrame = ThisComponent.CurrentController.getFrame()  
         executeCommand( ".uno:Deselect", oFrame )  
       End If  
    End If  
  End If  
End Sub  
  
  
Sub SelectionChange_disposing(  )  
End Sub  
  
  
Sub executeCommand( sCommand As String, oFrame As Object )  
  Dim aArr(0) As New com.sun.star.beans.PropertyValue  
  Dim oDispatch As Object  
  
  oDispatch = CreateUnoService( "com.sun.star.frame.DispatchHelper")  
  oDispatch.executeDispatch( oFrame, sCommand, "", 0, aArr())  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Global oListener As Object  
Global Cellule As Object  
  
  
Sub lancement_GestionEvenement 
  'Objet pour gérer l'événement Change dans la cellule B1, dans la 1ere feuille 
  Cellule = ThisComponent.Sheets(0).GetCellRangeByName("B1") 
  
  oListener = CreateUnoListener( "Classeur_" , "com.sun.star.util.XModifyListener" )  
  Cellule.addmodifylistener(olistener)  
End Sub  
  
  
Sub Classeur_Modified(oEvent) 
  If oEvent.Source.CellBackColor = RGB(255,255,255) Then  
    oEvent.Source.CellBackColor = RGB(0,0,255) 'Bleu 
  Else  
    oEvent.Source.CellBackColor = RGB(255,255,255) 'Blanc 
  End If         
End Sub 
  
  
Sub Classeur_Disposing(oEvent)  
End Sub