OVH Cloud OVH Cloud

macro appeler dossier

13 réponses
Avatar
Izmi
Bonjour ;

Y - aurait - il moyen de placer une macro sur une page
word pour appeler un dossier placer sur le bureau
comprenant plusieurs sous dossiers, fichiers excel,
documents word, PDF etc...

Merci

3 réponses

1 2
Avatar
Clément Marcotte
Bonjour,

Probablement qu'en raboutant ceci au choix du dossier et en ajustant
pour le nom du fichier.

Déclarations dans l'entête du module:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1


Puis ceci:


Sub lancefichier()
'Clément Marcotte
'Amos (Québec)
'Grandement inspiré de KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail:
'Send an E-Mail to the KPD-Team
ShellExecute hwnd, vbNullString, "c:windowsbureaudelai1.xls",
vbNullString, "C:", SW_SHOWNORMAL
End Sub

Le choix de l'application qui va ouvrir le fichier découle
vraisemblablement des associations de fichiers dans Windows.

--
On n' apprend pas à un vieux singe à faire des grimaces
"Izmi" a écrit dans le message de
news:04ab01c56082$d39cc9d0$
Bonjour ;

Merci à ceux qui m'ont répondu.
Il semble qu'il m'appartient de me grouiller un peu plus
pour que ceux qui veulent m'aider me comprennent mieux.

Bon, c'est fait.

Sur un site dont je n'ai pas retenu le nom j'ai recueilli
ce code qui se rapproche beaucoup de celui de Clément et
qui me convient bien. Je voudrais votre aide pour que si
je selectionne un fichier dans la boite de dialogue,
celui-ci s'ouvre.

Voici le code :

Sub essai1212()
choix = ChoixDossierFichier("c:windowsbureauEau",
1) '<- ici le chemin de ton
'choix
If choix <> "" Then MsgBox choix
End Sub

Function ChoixDossierFichier(Racine, Optional SelType As
Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash,
FlagChoix&, Msg$

If SelType = 0 Then
FlagChoix = &H1&: Msg = "Choisissez un dossier :"
Else
FlagChoix = &H4000&: Msg = "Choisissez un fichier :"
End If

Set objShell = CreateObject("Shell.Application")
'le troisi?me param?tre permet de choisir
'la s&eacute;lection d'un dossier ou d'un fichier (0
ou 1)
'le dernier param?tre permet de choisir le dossier
racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg,
FlagChoix, Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1,
2) & ""
End If
ChoixDossierFichier = Chemin

End Function

Merci.
-----Message d'origine-----
Bonjour,

P.S. Faut sélectionner le nom du fichier dans un
document Word, avant

de lancer la macro.

P.P.S : Manque aussi les déclarations à mettre dans
l'entête du

module, en dehors de toute procédure:

Declare Function SearchTreeForFile Lib "imagehlp" (ByVal
RootPath As

String, _
ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long
Public Const MAX_PATH = 260

--
On n' apprend pas à un vieux singe à faire des grimaces
"Clément Marcotte" a
écrit dans le

message de news:u2O3au$
Bonjour,

La mémoire m'a fait défaut. Voici une macro pour
retrouver un


fichier
enfoui dans une arborescence du bureau:

Sub ChercheSurLedisque()
'Clément Marcotte
'Amos (Québec)
'Grandement inspiré de allapi.net
'URL: http://www.allapi.net/
'E-Mail:
Dim tempStr As String, Ret As Long, lefichier As
String


Dim message As String, laplace As String, lendroit
As Byte


'create a buffer string
tempStr = String(MAX_PATH, 0)
'Si le fichier existe, le résultat est 1
'autrement, le résultat est 0
lendroit = InStr(Selection, Chr(13))
If lendroit > 0 Then
lefichier = Left(Selection, Len(Selection) - 1)
End If
lefichier = Trim(lefichier)
Ret = SearchTreeForFile("c:windowsbureau",
lefichier, tempStr)


If Ret <> 0 Then
laplace = Left$(tempStr, InStr(1, tempStr,
Chr$(0)) - 1)


Selection.MoveRight Unit:=wdCharacter, Count:=2,
Extend:=wdMove


Selection.InsertAfter (laplace)
message = "Le fichier " & lefichier & vbNewLine
message = message & " a été trouvé dans " &
vbNewLine


message = message & laplace
MsgBox message

Else
laplace = "Fichier non trouvé ou inexistant :"
MsgBox laplace & lefichier
End If
End Sub


--
On n' apprend pas à un vieux singe à faire des grimaces
"Izmi" a écrit dans
le message de


news:061701c55fbb$35a27710$
Bonjour ;

Y - aurait - il moyen de placer une macro sur une
page



word pour appeler un dossier placer sur le bureau
comprenant plusieurs sous dossiers, fichiers excel,
documents word, PDF etc...

Merci




.





Avatar
Izmi
Rebonjour

Merci bien Clément. Le code que vous m'avez proposé est
très bon.

Mais tant que j'y suis autant abuser :)

Voila mon autre problème :

Avec le code que vous m'avez proposé j'arrive
effectivement à faire ce que je voulais mais seulement en
cliquant sur le fichier à lancer avec le bouton droit et
en cliquant sur ouvrir dans le menu contextuel. Ne serait-
il pas possible de faire la même chose en cliquant ou
double cliquant sur l'arborescence du dossier ? Ou, mieux
encore, en ayant un bouton supplémentaire sur la boite de
dialogue avec lequel on ouvre le fichier sélectionné.

Merci beaucoup.

-----Message d'origine-----
Bonjour,

Probablement qu'en raboutant ceci au choix du dossier et
en ajustant

pour le nom du fichier.

Déclarations dans l'entête du module:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As
String, _

ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1


Puis ceci:


Sub lancefichier()
'Clément Marcotte
'Amos (Québec)
'Grandement inspiré de KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail:
'Send an E-Mail to the KPD-Team
ShellExecute hwnd,
vbNullString, "c:windowsbureaudelai1.xls",

vbNullString, "C:", SW_SHOWNORMAL
End Sub

Le choix de l'application qui va ouvrir le fichier
découle

vraisemblablement des associations de fichiers dans
Windows.


--
On n' apprend pas à un vieux singe à faire des grimaces
"Izmi" a écrit dans le
message de

news:04ab01c56082$d39cc9d0$
Bonjour ;

Merci à ceux qui m'ont répondu.
Il semble qu'il m'appartient de me grouiller un peu plus
pour que ceux qui veulent m'aider me comprennent mieux.

Bon, c'est fait.

Sur un site dont je n'ai pas retenu le nom j'ai recueilli
ce code qui se rapproche beaucoup de celui de Clément et
qui me convient bien. Je voudrais votre aide pour que si
je selectionne un fichier dans la boite de dialogue,
celui-ci s'ouvre.

Voici le code :

Sub essai1212()
choix = ChoixDossierFichier("c:windowsbureauEau",
1) '<- ici le chemin de ton
'choix
If choix <> "" Then MsgBox choix
End Sub

Function ChoixDossierFichier(Racine, Optional SelType As
Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash,
FlagChoix&, Msg$

If SelType = 0 Then
FlagChoix = &H1&: Msg = "Choisissez un dossier :"
Else
FlagChoix = &H4000&: Msg = "Choisissez un
fichier :"

End If

Set objShell = CreateObject("Shell.Application")
'le troisi?me param?tre permet de choisir
'la sélection d'un dossier ou d'un fichier (0
ou 1)
'le dernier param?tre permet de choisir le dossier
racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg,
FlagChoix, Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1,
2) & ""
End If
ChoixDossierFichier = Chemin

End Function

Merci.
-----Message d'origine-----
Bonjour,

P.S. Faut sélectionner le nom du fichier dans un
document Word, avant

de lancer la macro.

P.P.S : Manque aussi les déclarations à mettre dans
l'entête du

module, en dehors de toute procédure:

Declare Function SearchTreeForFile Lib "imagehlp" (ByVal
RootPath As

String, _
ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long
Public Const MAX_PATH = 260

--
On n' apprend pas à un vieux singe à faire des grimaces
"Clément Marcotte" a
écrit dans le

message de news:u2O3au$
Bonjour,

La mémoire m'a fait défaut. Voici une macro pour
retrouver un


fichier
enfoui dans une arborescence du bureau:

Sub ChercheSurLedisque()
'Clément Marcotte
'Amos (Québec)
'Grandement inspiré de allapi.net
'URL: http://www.allapi.net/
'E-Mail:
Dim tempStr As String, Ret As Long, lefichier As
String


Dim message As String, laplace As String, lendroit
As Byte


'create a buffer string
tempStr = String(MAX_PATH, 0)
'Si le fichier existe, le résultat est 1
'autrement, le résultat est 0
lendroit = InStr(Selection, Chr(13))
If lendroit > 0 Then
lefichier = Left(Selection, Len(Selection) - 1)
End If
lefichier = Trim(lefichier)
Ret = SearchTreeForFile("c:windowsbureau",
lefichier, tempStr)


If Ret <> 0 Then
laplace = Left$(tempStr, InStr(1, tempStr,
Chr$(0)) - 1)


Selection.MoveRight Unit:=wdCharacter, Count:=2,
Extend:=wdMove


Selection.InsertAfter (laplace)
message = "Le fichier " & lefichier & vbNewLine
message = message & " a été trouvé dans " &
vbNewLine


message = message & laplace
MsgBox message

Else
laplace = "Fichier non trouvé ou inexistant :"
MsgBox laplace & lefichier
End If
End Sub


--
On n' apprend pas à un vieux singe à faire des
grimaces



"Izmi" a écrit dans
le message de


news:061701c55fbb$35a27710$
Bonjour ;

Y - aurait - il moyen de placer une macro sur une
page



word pour appeler un dossier placer sur le bureau
comprenant plusieurs sous dossiers, fichiers excel,
documents word, PDF etc...

Merci




.



.






Avatar
Clément Marcotte
Bonjour,

Juste à utiliser une des boîtes de dialogues communes de Windows

Section des déclarations:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Avec cette macro:

Sub OuvrirFichierAvecAPI()
'Clément Marcote
'Amos (Québec)
'Grandement inspiré de KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail:
Dim OFName As OPENFILENAME
OFName.lStructSize = Len(OFName)
'Set the parent window
OFName.hwndOwner = hwnd
'Set the application's instance
OFName.hInstance = hInstance
'Select a filter
OFName.lpstrFilter = "Tous les fichiers (*.*)" + Chr$(0) + "*.*"
'create a buffer for the file
OFName.lpstrFile = Space$(254)
'set the maximum length of a returned file
OFName.nMaxFile = 255
'Create a buffer for the file title
OFName.lpstrFileTitle = Space$(254)
'Set the maximum length of a returned file title
OFName.nMaxFileTitle = 255
'Set the initial directory
OFName.lpstrInitialDir = "C:"
'Set the title
OFName.lpstrTitle = "Chercher et Ouvrir un fichier"
'No flags
OFName.flags = 0

'Ouvrir le fichier
If GetOpenFileName(OFName) Then
ShellExecute hwnd, vbNullString, Trim$(OFName.lpstrFile),
vbNullString, "C:", SW_SHOWNORMAL

Else
MsgBox "Opération annulée"
End If
End Sub



--
On n' apprend pas à un vieux singe à faire des grimaces
"Izmi" a écrit dans le message de
news:054c01c56095$8e241490$
Rebonjour

Merci bien Clément. Le code que vous m'avez proposé est
très bon.

Mais tant que j'y suis autant abuser :)

Voila mon autre problème :

Avec le code que vous m'avez proposé j'arrive
effectivement à faire ce que je voulais mais seulement en
cliquant sur le fichier à lancer avec le bouton droit et
en cliquant sur ouvrir dans le menu contextuel. Ne serait-
il pas possible de faire la même chose en cliquant ou
double cliquant sur l'arborescence du dossier ? Ou, mieux
encore, en ayant un bouton supplémentaire sur la boite de
dialogue avec lequel on ouvre le fichier sélectionné.

Merci beaucoup.

-----Message d'origine-----
Bonjour,

Probablement qu'en raboutant ceci au choix du dossier et
en ajustant

pour le nom du fichier.

Déclarations dans l'entête du module:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As
String, _

ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1


Puis ceci:


Sub lancefichier()
'Clément Marcotte
'Amos (Québec)
'Grandement inspiré de KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail:
'Send an E-Mail to the KPD-Team
ShellExecute hwnd,
vbNullString, "c:windowsbureaudelai1.xls",

vbNullString, "C:", SW_SHOWNORMAL
End Sub

Le choix de l'application qui va ouvrir le fichier
découle

vraisemblablement des associations de fichiers dans
Windows.


--
On n' apprend pas à un vieux singe à faire des grimaces
"Izmi" a écrit dans le
message de

news:04ab01c56082$d39cc9d0$
Bonjour ;

Merci à ceux qui m'ont répondu.
Il semble qu'il m'appartient de me grouiller un peu plus
pour que ceux qui veulent m'aider me comprennent mieux.

Bon, c'est fait.

Sur un site dont je n'ai pas retenu le nom j'ai recueilli
ce code qui se rapproche beaucoup de celui de Clément et
qui me convient bien. Je voudrais votre aide pour que si
je selectionne un fichier dans la boite de dialogue,
celui-ci s'ouvre.

Voici le code :

Sub essai1212()
choix = ChoixDossierFichier("c:windowsbureauEau",
1) '<- ici le chemin de ton
'choix
If choix <> "" Then MsgBox choix
End Sub

Function ChoixDossierFichier(Racine, Optional SelType As
Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash,
FlagChoix&, Msg$

If SelType = 0 Then
FlagChoix = &H1&: Msg = "Choisissez un dossier :"
Else
FlagChoix = &H4000&: Msg = "Choisissez un
fichier :"

End If

Set objShell = CreateObject("Shell.Application")
'le troisi?me param?tre permet de choisir
'la sélection d'un dossier ou d'un fichier (0
ou 1)
'le dernier param?tre permet de choisir le dossier
racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg,
FlagChoix, Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1,
2) & ""
End If
ChoixDossierFichier = Chemin

End Function

Merci.
-----Message d'origine-----
Bonjour,

P.S. Faut sélectionner le nom du fichier dans un
document Word, avant

de lancer la macro.

P.P.S : Manque aussi les déclarations à mettre dans
l'entête du

module, en dehors de toute procédure:

Declare Function SearchTreeForFile Lib "imagehlp" (ByVal
RootPath As

String, _
ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long
Public Const MAX_PATH = 260

--
On n' apprend pas à un vieux singe à faire des grimaces
"Clément Marcotte" a
écrit dans le

message de news:u2O3au$
Bonjour,

La mémoire m'a fait défaut. Voici une macro pour
retrouver un


fichier
enfoui dans une arborescence du bureau:

Sub ChercheSurLedisque()
'Clément Marcotte
'Amos (Québec)
'Grandement inspiré de allapi.net
'URL: http://www.allapi.net/
'E-Mail:
Dim tempStr As String, Ret As Long, lefichier As
String


Dim message As String, laplace As String, lendroit
As Byte


'create a buffer string
tempStr = String(MAX_PATH, 0)
'Si le fichier existe, le résultat est 1
'autrement, le résultat est 0
lendroit = InStr(Selection, Chr(13))
If lendroit > 0 Then
lefichier = Left(Selection, Len(Selection) - 1)
End If
lefichier = Trim(lefichier)
Ret = SearchTreeForFile("c:windowsbureau",
lefichier, tempStr)


If Ret <> 0 Then
laplace = Left$(tempStr, InStr(1, tempStr,
Chr$(0)) - 1)


Selection.MoveRight Unit:=wdCharacter, Count:=2,
Extend:=wdMove


Selection.InsertAfter (laplace)
message = "Le fichier " & lefichier & vbNewLine
message = message & " a été trouvé dans " &
vbNewLine


message = message & laplace
MsgBox message

Else
laplace = "Fichier non trouvé ou inexistant :"
MsgBox laplace & lefichier
End If
End Sub


--
On n' apprend pas à un vieux singe à faire des
grimaces



"Izmi" a écrit dans
le message de


news:061701c55fbb$35a27710$
Bonjour ;

Y - aurait - il moyen de placer une macro sur une
page



word pour appeler un dossier placer sur le bureau
comprenant plusieurs sous dossiers, fichiers excel,
documents word, PDF etc...

Merci




.



.






1 2