FAQ LibreOffice et Apache OpenOfficeConsultez toutes les FAQ

Nombre d'auteurs : 10, nombre de questions : 359, dernière mise à jour : 15 juillet 2017  Ajouter une question

 

Bienvenue sur la FAQ, elle a été réalisée pour répondre aux questions concernant les suites bureautiques Apache OpenOffice (AOO) et LibreOffice (LibO).

Si vous souhaitez participer pour l'améliorer, pour proposer vos contributions ou si vous constatez des erreurs dans cette page, n'hésitez-pas !!! Participez.


SommaireProgrammation OBasicLes répertoires (8)
précédent sommaire suivant
 

Première méthode :

Code vb : Sélectionner tout
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
Sub ListeFichiersDuRepertoire_V01 
' 
'Liste tous les fichiers d'un répertoire 
'Les fichiers masqués sont pris en compte 
'Cet exemple permet aussi de vérifier si le répertoire est vide 
' 
Dim Direction As String , Resultat As String 
  
'Indiquez le répertoire cible 
'(La procédure ne renvoie pas d'erreur si le dossier n'existe pas) 
Direction=Dir("C:\Documents and Settings\michel\dossier\general\*.*",0) 
' 
'------ 
'Un autre exemple pour lister uniquement les fichiers de type PDF : 
'Direction=Dir("C:\Documents and Settings\michel\dossier\general\*.pdf",0) 
'------ 
  
Do While Len(Direction) > 0 
	Resultat = Resultat & Chr(13) & Direction 
	Direction=Dir() 
Loop 
  
If Resultat="" then 
	MsgBox "Le répertoire est vide." 
	Else 
	Msgbox Resultat ,,"Liste des fichiers."  
End If 
End Sub

Une deuxième solution : le chemin complet est renvoyé.
Code vb : Sélectionner tout
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
Sub ListeFichiersDuRepertoire_V02 
' 
'Liste tous les fichiers d'un répertoire 
'Les fichiers masqués sont pris en compte 
'Cet exemple permet aussi de vérifier si le répertoire est vide 
' 
Dim Chemin As String , NomObj As String , Resultat As String 
Dim oSimpleFileAccess As Object 
Dim i As Integer  
Dim Tableau() 
  
'Attention : la procédure provoque une erreur si le dossier n'existe pas  
Chemin ="C:\Documents and Settings\michel\dossier\general\" 
  
oSimpleFileAccess = CreateUnoService( "com.sun.star.ucb.SimpleFileAccess" )  
'Transfert la liste des fichiers dans un Tableau 
Tableau = oSimpleFileAccess.getFolderContents(ConvertToURL( Chemin ), True )  
  
If UBound(Tableau)= -1 Then MsgBox "Le répertoire est vide." 
  
For i = 1 To UBound(Tableau) + 1 
	NomObj = Tableau( i-1 )    
	If Not oSimpleFileAccess.isFolder( NomObj ) Then _ 
		Resultat = Resultat & ConvertFromURL( NomObj ) & Chr(13)  
Next i 
  
MsgBox Resultat 
End Sub

Mis à jour le 26 août 2013 SilkyRoad

Première méthode.
Nota : les sous répertoires ne sont pas pris en compte.

Code vb : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub listerRepertoires_V01 
Dim Cible As String , Chemin As String 
  
Chemin ="C:\Documents and Settings\michel\dossier\general\" 
Cible =Dir(Chemin ,16) 
  
If Cible <> "" Then 
	Do 
	  If Cible <>"." And Cible <>".." Then MsgBox Cible 
	  '".." et "." correspondent aux dossiers Parent et courant  
	  Cible =Dir 
	Loop Until Cible ="" 
End If 
End Sub


Deuxième possibilité.
Code vb : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub listerRepertoires_V02 
Dim Chemin As String , NomObj As String 
Dim oSimpleFileAccess As Object 
Dim i As Integer  
Dim Tableau() 
  
Chemin ="C:\Documents and Settings\michel\dossier\general\" 
  
oSimpleFileAccess = CreateUnoService( "com.sun.star.ucb.SimpleFileAccess" )  
Tableau = oSimpleFileAccess.getFolderContents(ConvertToURL( Chemin ), True )  
  
For i = 1 To UBound(Tableau) + 1 
	NomObj = Tableau( i-1 )    
	If oSimpleFileAccess.isFolder( NomObj ) Then _ 
		MsgBox ConvertFromURL( NomObj )  
Next i 
End Sub

Mis à jour le 26 août 2013 SilkyRoad

Code vb : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
Sub VerifieExistenceRepertoire_V01 
Dim Chemin As String 
  
Chemin = "C:\Documents and Settings\michel\dossierOOo" 
  
If Dir(Chemin,vbDirectory) > "" then 
	MsgBox "Ce dossier existe." 
	Else 
	MsgBox "Ce dossier n'existe pas." 
End If 
End Sub

Une deuxième solution consiste à utiliser la fonction FileExists.
Code vb : Sélectionner tout
1
2
3
4
5
6
7
8
9
Sub VerifieExistenceRepertoire_V02 
Dim Dossier As String, urlDossier As String 
  
Dossier = "C:\Documents and Settings\michel\dossierOOo"  
  
urlDossier = ConvertToURL( Dossier ) 
'Renvoie False ou True  
MsgBox FileExists( urlDossier ) 
End Sub

Mis à jour le 26 août 2013 SilkyRoad

Code vb : Sélectionner tout
1
2
3
4
5
Sub creerRepertoire 
'Crée un nouveau dossier nommé "DossierSauvegarde" 
'Les répertoires parents seront aussi créés s'ils n'existaient pas 
MkDir "C:\mon projet\DossierSauvegarde\Archives"  
End Sub

Mis à jour le 2 août 2013 SilkyRoad

Code vb : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
Sub selectionRepertoire  
Dim Dossier As Object  
Dim Valeur As Integer  
  
Dossier = _ 
  CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")  
Valeur = Dossier.Execute()  
  
If Valeur = 1 Then _ 
  MsgBox ConvertFromUrl(Dossier.getDirectory())  
End Sub

Mis à jour le 2 août 2013 SilkyRoad

Cet exemple doit être placé dans un classeur Tableur: le résultat s'affiche dans la feuille de calcul.

Code vb : Sélectionner tout
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
Sub lister_PathSettings  
Dim j As Integer , i As integer , x As Integer 
Dim oPathSettings As Object , objProprieteSetInfo As Object  
Dim Tableau() ,  TabChemin() 
Dim objPropriete As Object , Feuille As Object 
Dim ValPropriete As String , NomPropriete As String , Chemin As String 
  
oPathSettings = CreateUnoService( "com.sun.star.util.PathSettings" )  
  
objProprieteSetInfo = oPathSettings.getPropertySetInfo() 
'Transfert les données dans le tableau  
Tableau = objProprieteSetInfo.getProperties()  
  
'Spécifie la 1ere feuille du classeur 
Feuille = ThisComponent.Sheets(0) 
  
'Boucle sur le tableau pour extraire les résultats       
For i = LBound( Tableau ) To UBound( Tableau )  
	objPropriete = Tableau( i )  
	NomPropriete = objPropriete.Name  
	ValPropriete = oPathSettings.getPropertyValue( NomPropriete )  
	Feuille.getCellByPosition( 0 , x ).setString( NomPropriete ) 
  
	If Len( ValPropriete ) > 0 Then  
	  TabChemin = Split( ValPropriete, ";" )  
  
	  For j = LBound( TabChemin ) To UBound( TabChemin )  
	    Chemin = ConvertFromURL( TabChemin( j ))  
	    Feuille.getCellByPosition( 1 , x ).setString( NomPropriete & " : " & Chemin ) 
	    x = x + 1 
	  Next 
	End If  
  
	x = x + 1             
Next i  
End Sub

Mis à jour le 26 août 2013 SilkyRoad

Code vb : Sélectionner tout
1
2
3
4
5
6
7
Sub ouvrirExplorateurWindows()  
Dim oShell As Object  
oShell = createUnoService("com.sun.star.system.SystemShellExecute")  
  
'La procédure renvoie un message d'erreur si le répertoire n'existe pas 
oShell.execute(ConvertToUrl("C:\Documents and Settings\michel\dossier"), "", 0)  
End Sub

Mis à jour le 2 août 2013 SilkyRoad

La procédure crée un raccourci sur le bureau pour le fichier contenant cette macro.

Code vb : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub CreerRaccourciBureau() 
  Dim WshShell As Object , Raccourci As Object 
  Dim dirBureau As String 
  
  oObj = createUnoService("com.sun.star.bridge.OleObjectFactory") 
  WshShell = oObj.createInstance("WScript.Shell") 
  dirBureau = Environ("USERPROFILE") & "\Bureau\" 'adaptez le chemin du bureau 
  
  Raccourci = WshShell.createShortcut( dirBureau & "monFichier.lnk") 
  
  Raccourci.TargetPath = ConvertFromURL( ThisComponent.Location ) 
  'Raccourci.IconLocation = "C:\dating.ico" 'Attribue un icône spécifique au raccourci 
  Raccourci.Save 
  
End Sub

Mis à jour le 2 août 2013 SilkyRoad

Proposer une nouvelle réponse sur la FAQ

Ce n'est pas l'endroit pour poser des questions, allez plutôt sur le forum de la rubrique pour ça


Réponse à la question

Liens sous la question
précédent sommaire suivant
 

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2020 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.