FAQ LibreOffice et Apache OpenOfficeConsultez toutes les FAQ

1
2
3
4
Dim oDoc As Object 
  
oDoc=ThisComponent 'Spécifie le tableur contenant la macro 
MsgBox oDoc.Sheets.Count

1
2
3
4
5
6
7
8
9
10
Dim oDoc As Object 
  
oDoc=ThisComponent 
  
'Vérifie si la feuille nommée "Feuille2" existe 
If oDoc.Sheets.hasByName("Feuille2") Then  
	MsgBox "La feuille existe" 
	Else 
	MsgBox "La feuille n'existe pas" 
End If

1
2
3
4
5
6
7
8
9
Dim oDoc As Object 
Dim i As Integer 
  
oDoc=ThisComponent 
  
For i = 1 to oDoc.Sheets.Count 
	'Remarque: l'index de la 1ere feuille = 0 
	MsgBox oDoc.Sheets(i-1).Name 
Next

1
2
3
4
5
6
7
8
9
Dim oDoc As Object , Feuille As Object 
  
oDoc=ThisComponent 
  
Feuille = oDoc.getCurrentController().getActiveSheet() 
MsgBox Feuille.getName() 
  
'Une autre solution 
MsgBox oDoc.CurrentController.ActiveSheet.getName

1
2
3
4
5
6
Dim oDoc As Object 
  
oDoc=ThisComponent 
  
'Supprime la feuille nommée "Feuille3" 
oDoc.GetSheets.RemoveByName("Feuille3")

1
2
3
4
5
6
Dim oDoc As Object 
  
oDoc=ThisComponent 
  
'Déplace la feuille nommée "Feuille2" à la fin 
oDoc.getSheets.moveByName("Feuille2",oDoc.Sheets.Count)

1
2
3
4
5
6
Dim oDoc As Object 
  
oDoc=ThisComponent 
  
'Ajoute une feuille, la nomme et place l'onglet en 3eme position 
oDoc.GetSheets.insertNewByName("ma nouvelle feuille",2)

1
2
3
4
5
6
7
Dim oDoc As Object , Feuille As Object 
  
oDoc=ThisComponent 
  
'Renomme la feuille nommée "Feuille1" 
Feuille = oDoc.getSheets.getByName("Feuille1") 
Feuille.Name = "le nouveau nom"

1
2
3
4
5
6
7
Dim oDoc As Object 
  
oDoc=ThisComponent 
  
'Duplique la "Feuille2" et la place en première position  
oDoc.getSheets.copyByName("Feuille2", "Copie Feuille2", 0) 
'La syntaxe: copyByName(NomFeuille_A_Dupliquer, NomCopie, IndexPosition)

1
2
3
4
5
6
7
8
9
10
Dim oDoc As Object , Feuille As Object 
  
oDoc=ThisComponent 
  
'Masque la feuille nommée "Feuille2" 
Feuille = oDoc.getSheets.getByName("Feuille2") 
Feuille.IsVisible = False 
  
'Pour réafficher la feuille 
'Feuille.IsVisible = True

1
2
3
4
5
6
7
8
9
10
11
12
Sub ProtegerFeuille 
  Dim Feuille As Object 
  
  'Définit la feuille à Protéger 
  Feuille = ThisComponent.Sheets.GetByName("Feuille1") 
  
  'Affecte la protection 
  Feuille.Protect("") 
  
  'Exemple avec mot de passe 
  'Feuille.Protect("MotDePasse")   
End Sub

1
2
3
4
5
6
7
8
9
Sub VerifierProtectionFeuille 
  Dim Feuille As Object 
  
  'Définit la feuille à Protéger 
  Feuille = ThisComponent.Sheets.GetByName("Feuille1") 
  
  'Renvoie True ou False 
  MsgBox Feuille.IsProtected 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub DeProtegerFeuille 
  Dim Feuille As Object 
  
  'Définit la feuille à Protéger 
  Feuille = ThisComponent.Sheets.GetByName("Feuille1") 
  
  'Déprotection 
  Feuille.UnProtect("") 
  
  'Exemple pour Déprotection par mot de passe 
  'Feuille.UnProtect("MotDePasse") 
  
    'Nota1: 
    'La procédure ne renvoie pas de message d'erreur si le mot 
    'de passe spécifié est erroné. 
  
    'Nota2: 
    '/!\ Les mots de passes sont sensibles à la casse /!\  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub LiensCellules_SourceClasseurFerme 
  Dim objFeuille As Object 
  Dim sURL As String , strFeuille As String 
  Dim Mde As Variant 
  
  'Chemin du classeur fermé 
  sURL = ConvertToURL("C:\Documents and Settings\dossier\NomClasseur.ods")  
  'Nom de la feuille dans le classeur fermé. 
  strFeuille = "NomFeuille"  
  
  Mde = com.sun.star.sheet.SheetLinkMode.NORMAL  
  
  'Spécifie la feuille qui va recevoir les données 
  objFeuille = ThisComponent.Sheets(0) 
  'Création lien 
  objFeuille.link(sURL, strFeuille , "" , "" , Mde)  
End Sub

1
2
3
4
5
6
7
8
Dim oDoc As Object , Feuille As Object 
  
oDoc = ThisComponent 
Feuille = oDoc.getSheets.getByName("Feuille1") 
  
Feuille.setLinkMode(com.sun.star.sheet.SheetLinkMode.NONE)  
'ou 
'Feuille.LinkMode = com.sun.star.sheet.SheetLinkMode.NONE

1
2
3
4
Dim i As Integer 
  
i = 5 '0 est l'index de la premiere colonne (A) 
MsgBox ThisComponent.Sheets(0).Columns( i ).getName

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
Sub modificationEntete_Et_PiedDePage() 
  Dim leStyle As Object, Entete As Object, piedPage As Object 
  Dim oText As Object, Curseur As Object, leChamp As Object 
  
  'Définit la feuille active 
  Feuille = ThisComponent.CurrentController.getActiveSheet 
  
  leStyle = ThisComponent.StyleFamilies.getByName("PageStyles").getByName(Feuille.PageStyle) 
  
  'Accès à l'entête de page 
    Entete = leStyle.RightPageHeaderContent 
    oText = Entete.LeftText 
    oText.setString ("") 'Efface les données existante dans l'entête de page 
  
    Set Curseur = oText.CreateTextCursor() 
  
    With Curseur 'mise en forme 
      .CharWeight = com.sun.star.awt.FontWeight.BOLD 'Gras 
      .CharPosture = com.sun.star.awt.FontSlant.ITALIC 
      .CharFontName = "Arial" 
      .CharHeight = "12" 'taille caractères 
    End With 
  
   oText.insertString Curseur, "Les données à insérer", False 
  '------------------------------------------------------- 
  
  'pour insérer le Numéro de page en pied de page 
    piedPage = leStyle.RightPageFooterContent 
    oText = piedPage.CenterText 
    oText.setString ("") 'RAZ 
    Set Curseur = oText.CreateTextCursor() 
  
  'Création d'un champ "PageNumber" 
   leChamp = ThisComponent.createInstance("com.sun.star.text.TextField.PageNumber") 
   oText.insertTextContent Curseur , leChamp , False 
  '------------------------------------------------------- 
  
  leStyle.RightPageHeaderContent = Entete 
  leStyle.RightPageFooterContent = piedPage 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub LireContenu_Entete_Et_PiedDePage  
  Dim Feuille As Object , leStyle As Object 
  Dim PiedPage As Object  
  
  'Définit la feuille active 
  Feuille = ThisComponent.CurrentController.getActiveSheet 
  
  leStyle = ThisComponent.StyleFamilies.getByName("PageStyles").getByName(Feuille.PageStyle) 
  
  Entete = leStyle.RightPageHeaderContent 
    MsgBox Entete.LeftText.getString 
    'MsgBox Entete.RightText.getString 
    'MsgBox Entete.CenterText.getString 
  
  PiedPage = leStyle.RightPageFooterContent 
    MsgBox PiedPage.LeftText.getString 
    'MsgBox PiedPage.RightText.getString 
    'MsgBox PiedPage.CenterText.getString   
  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub TriOnglets  
  Dim Feuilles As Object 
  Dim i As Integer , j as integer 
  
  Feuilles = ThisComponent.Sheets 
  
  If Feuilles.Count > 1 Then 
    For j = 0 To Feuilles.Count - 2  
       For i = 0 To Feuilles.Count - 2 
  
         If Feuilles.getByIndex( i ).Name > Feuilles.getByIndex( i + 1 ).Name Then _ 
           Feuilles.moveByName( Feuilles.getByIndex( i + 1 ).Name , i )  
  
      Next i 
    Next j 
  End If  
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 Test 
  'Trie les feuilles à partir du 4eme onglet 
  '(L'index 3 correspond à 4eme feuille du classeur) 
  TriFeuilles( 3 ) 
End Sub 
  
  
Sub TriFeuilles( NumFeuille As Integer ) 
  Dim Feuilles As Object 
  Dim i As Integer  
  Dim Cible As Boolean  
  
  Feuilles = ThisComponent.Sheets  
  
  If Feuilles.Count > 1 Then 
    Do  
  
    Cible = False  
    For i = NumFeuille To Feuilles.Count - 2  
      If Feuilles.getByIndex( i ).Name > Feuilles.getByIndex( i + 1 ).Name Then  
        Feuilles.moveByName( Feuilles.getByIndex( i + 1 ).Name , i )  
        Cible = True  
      End If       
    Next 
  
    Loop Until Cible = False  
  End If  
  
End Sub

1
2
3
4
Dim Feuille As Object 
'spécifie la 3eme feuille  
Feuille = ThisComponent.Sheets(2) 
ThisComponent.CurrentController.ActiveSheet = Feuille

1
2
3
4
5
Dim Feuille As Object 
'Spécifie la 2eme feuille  
Feuille = ThisComponent.Sheets(1) 
'Active la feuille et sélectionne la cellule A10 
ThisComponent.CurrentController.Select( Feuille.getCellRangeByName("A10") )

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
Sub NomFeuillesMultiplesSelectionnees() 
  Dim OngletsSelectionnes As String 
  Dim TableauOnglets() As String 
  Dim i As Integer 
  Dim Cible As Object 
  Dim Collect As New Collection 
  Dim NomFeuille As String 
  
  Cible = ThisComponent.CurrentController 
  
  If Cible.Selection.supportsService("com.sun.star.sheet.SheetCellRanges")  Then 
    'S'il y a plusieurs feuilles de sélectionnées. 
    OngletsSelectionnes  = ThisComponent.CurrentSelection.RangeAddressesAsString 
    TableauOnglets() = Split( OngletsSelectionnes , ";" ) 
  
    On Error Resume Next 
    For i = 0 To UBound (TableauOnglets()) 
       NomFeuille = Left( TableauOnglets( i ) , Instr( 1 , TableauOnglets( i ) , "." ) - 1 ) 
       'Récupère le nom des feuilles sans doublon 
       Collect.Add NomFeuille , Cstr(NomFeuille) 
    Next i 
    On Error GoTo 0 
  
    For i = 1 To Collect.Count 
      MsgBox Collect(i) 
    Next 
  
  Else 
    'S'il y a une seule feuille de sélectionnée. 
    MsgBox Cible.ActiveSheet.getName 
  End If 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Global oListener As Object  
Global oClasseur As Object  
  
Sub lancement_GestionEvenement_SheetChange  
  oClasseur = ThisComponent 
  
  oListener = createUnoListener( "Classeur_" , "com.sun.star.beans.XPropertyChangeListener" )  
  oClasseur.CurrentController.addPropertyChangeListener( "ActiveSheet" , oListener )  
End Sub  
  
Sub Classeur_PropertyChange(oEvent)  
   MsgBox oEvent.Source.ActiveSheet.Name 
End Sub 
  
Sub Arret_GestionEvenement_SheetChange  
  oClasseur.CurrentController.removePropertyChangeListener( "ActiveSheet" , oListener )  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub CopieFeuilleActive_NouveauClasseur  
  Dim oFrame As Object  
  Dim oDisp As Object  
  Dim Args(2) As New com.sun.star.beans.PropertyValue  
  
  oFrame = ThisComponent.CurrentController.Frame  
  oDisp = createUnoService("com.sun.star.frame.DispatchHelper")  
  
  Args(0).Name = "DocName"  
  Args(0).Value = ""  
  Args(1).Name = "Index"  
  Args(1).Value = 65535  
  Args(2).Name = "Copy"  
  Args(2).Value = True  
  
  oDisp.ExecuteDispatch(oFrame, ".uno:Move", "", 0, Args())  
End Sub