Comment faire un lien hypertexte vers un répertoire et non pas vers un fichier particulier de ce répertoire ?
"Tu crées ton lien hypertexte sur un des fichiers du dossier.
Ensuite, tu modifies le lien hypertexte ( clic droit, lien hypertexte / modifier Lien hypertexte) en lui supprimant la dernière partie ( le nom du fichier)
exemple:
le lien hypertexte lors de sa création:
C:\Mes documents\MonDossier\MonFichier.xls
le lien hypertexte modifié, qui ouvre l'explorateur de fichier sur le dossier:
C:\Mes documents\MonDossier\"
Ensuite, tu modifies le lien hypertexte ( clic droit, lien hypertexte / modifier Lien hypertexte) en lui supprimant la dernière partie ( le nom du fichier)
exemple:
le lien hypertexte lors de sa création:
C:\Mes documents\MonDossier\MonFichier.xls
le lien hypertexte modifié, qui ouvre l'explorateur de fichier sur le dossier:
C:\Mes documents\MonDossier\"
Jean François Aubert,
Ajouté ou modifié le 11/12/2007 (N°1948)
Ajouté ou modifié le 11/12/2007 (N°1948)
Comment faire pour ouvrir un fichier situé sur une clef USB sachant que la lettre affectée à la clef dépend du PC sur lequel elle est insérée ?
Cette macro te permet de demander d'indiquer la lettre affectée à la clef.
Sub macro1()
Dim ss As SearchScope
Dim sf As ScopeFolder
rewind:
Lecteur = UCase(InputBox("Entrer la letrre du lecteur."))
With Application.FileSearch
For Each ss In .SearchScopes
Select Case ss.Type
Case msoSearchInMyComputer
For Each sf In ss.ScopeFolder.ScopeFolders
If Left(sf.Path, 1) = Lecteur Then
GoTo fin
Else
MsgBox "Ce lecteur n'existe pas"
GoTo rewind
End If
Next sf
Case Else
End Select
Next ss
End With
fin:
'MsgBox "Lecteur existe" 'Test
'Workbooks.OpenText Filename:="" & Lecteur & ":TonFichier.TXT", Origin:=xlWindows, _
End Sub
Sub macro1()
Dim ss As SearchScope
Dim sf As ScopeFolder
rewind:
Lecteur = UCase(InputBox("Entrer la letrre du lecteur."))
With Application.FileSearch
For Each ss In .SearchScopes
Select Case ss.Type
Case msoSearchInMyComputer
For Each sf In ss.ScopeFolder.ScopeFolders
If Left(sf.Path, 1) = Lecteur Then
GoTo fin
Else
MsgBox "Ce lecteur n'existe pas"
GoTo rewind
End If
Next sf
Case Else
End Select
Next ss
End With
fin:
'MsgBox "Lecteur existe" 'Test
'Workbooks.OpenText Filename:="" & Lecteur & ":TonFichier.TXT", Origin:=xlWindows, _
End Sub
Isabelle, Flo Cabon,
Ajouté ou modifié le 18/11/2007 (N°1922)
Ajouté ou modifié le 18/11/2007 (N°1922)
Peut-on lister les chemins complets + noms de fichiers à partir d'une liste
de raccourcis (Raccourci.lnk) dans un repertoire ?
Avec Shell.Application, pour récupérer les raccourcis du bureau.
Sub RecupShortCutsurBureau()
Dim ObjShell, ObjFolder
Set ObjShell = CreateObject("Shell.Application")
For Each ObjFolder In ObjShell.NameSpace(0).Items
If ObjFolder.IsLink Then
MsgBox ObjFolder.Path & vbNewLine & ObjFolder.GetLink.Path
End If
Next
Set ObjFolder = Nothing
Set ObjShell = Nothing
End Sub
Une autre approche possible :
Sub test()
Dim sLnk$
sLnk = "C:\Documents and Settings\FS\Menu Démarrer\" & _
"Programmes\Accessoires\Bloc-notes.lnk"
MsgBox CreateObject("WScript.Shell").CreateShortcut(sLnk).TargetPath
End Sub
Sub RecupShortCutsurBureau()
Dim ObjShell, ObjFolder
Set ObjShell = CreateObject("Shell.Application")
For Each ObjFolder In ObjShell.NameSpace(0).Items
If ObjFolder.IsLink Then
MsgBox ObjFolder.Path & vbNewLine & ObjFolder.GetLink.Path
End If
Next
Set ObjFolder = Nothing
Set ObjShell = Nothing
End Sub
Une autre approche possible :
Sub test()
Dim sLnk$
sLnk = "C:\Documents and Settings\FS\Menu Démarrer\" & _
"Programmes\Accessoires\Bloc-notes.lnk"
MsgBox CreateObject("WScript.Shell").CreateShortcut(sLnk).TargetPath
End Sub
Frédéric Sigonneau, Alain Cros,
Ajouté ou modifié le 30/05/2004 (N°1429)
Ajouté ou modifié le 30/05/2004 (N°1429)
Comment sélectionner le répertoire par défaut utilisé par la méthode GEtOpenFileName ?
Pour ouvrir dans le répertoire par défaut de l'application :
ChDir Application.DefaultFilePath
si tu veux ouvrir un autre dossier tu écris : Chdir "C:Mes Documentstototiti"
(n'oublie pas les guillemets)
Pour n'ouvrir dans un dossier que les fichiers ayant une extension particulière telle que *.txt :
toto = Application.GetOpenFilename("Text Files (*.txt), *.txt")
et pour afficher le résultat il te suffit d'ajouter
MsgBox toto
ChDir Application.DefaultFilePath
si tu veux ouvrir un autre dossier tu écris : Chdir "C:Mes Documentstototiti"
(n'oublie pas les guillemets)
Pour n'ouvrir dans un dossier que les fichiers ayant une extension particulière telle que *.txt :
toto = Application.GetOpenFilename("Text Files (*.txt), *.txt")
et pour afficher le résultat il te suffit d'ajouter
MsgBox toto
Denis Michon, (N°1269)
A partir d'un document, je crée une copie. Comment faire pour enregistrer cette copie dans le
même répertoire que l'original, sans connaître à l'avance le chemin de celui ci sachant que
je peux suivant les cas être sous mac ou sous PC ?
1°) Tester le système:
Systeme = Application.OperatingSystem
TypeSysteme = Left(Systeme, 1)
2°) Récupérer le chemin d'accès
Chemin = ActiveWorkbook.Path
Rapport = ThisWorkbook.Name
Rapport2 = Left(Rapport, 8) & "_Final.xls"
3°) En fonction du système choisir le chemin pour sauvegarder
If TypeSysteme = "M" Then .SaveAs Chemin & ":" & Rapport2
If TypeSysteme = "W" Then .SaveAs Chemin & "" & Rapport2
***************************
Une autre solution, plus rapide est d'utiliser directement
.SaveAs Chemin & Application.PathSeparator & Rapport2
En effet, Application.pathSeparator renvoie / pour les PC et : pour les mac. Il n'est donc plus
nécessaire avec cette instruction de tester le système.
Systeme = Application.OperatingSystem
TypeSysteme = Left(Systeme, 1)
2°) Récupérer le chemin d'accès
Chemin = ActiveWorkbook.Path
Rapport = ThisWorkbook.Name
Rapport2 = Left(Rapport, 8) & "_Final.xls"
3°) En fonction du système choisir le chemin pour sauvegarder
If TypeSysteme = "M" Then .SaveAs Chemin & ":" & Rapport2
If TypeSysteme = "W" Then .SaveAs Chemin & "" & Rapport2
***************************
Une autre solution, plus rapide est d'utiliser directement
.SaveAs Chemin & Application.PathSeparator & Rapport2
En effet, Application.pathSeparator renvoie / pour les PC et : pour les mac. Il n'est donc plus
nécessaire avec cette instruction de tester le système.
Bernard Ray, BOB,
Ajouté ou modifié le 03/09/2004 (N°1268)
Ajouté ou modifié le 03/09/2004 (N°1268)
Pour faciliter la saisie de données dans un classeur, je voudrais que les utilisateurs
puissent choisir à la souris un dossier. Quel code utiliser ?
Ce code est à placer dans un module du classeur (pas dans le code de la feuille).
dans une macro du classeur si tu tapes
sub essai()
....
GetDirectory
...
tu récupères dans la variable Dossier le chemin que l'utilisateur aura sélectionné
Public Dossier
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & "\"
Else
GetDirectory = ""
End If
End Function
Tu peux voir des exemples d'application dans
fc-sauvegardeauto
et dans
skfc-zipdossier
dans une macro du classeur si tu tapes
sub essai()
....
GetDirectory
...
tu récupères dans la variable Dossier le chemin que l'utilisateur aura sélectionné
Public Dossier
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & "\"
Else
GetDirectory = ""
End If
End Function
Tu peux voir des exemples d'application dans
fc-sauvegardeauto
et dans
skfc-zipdossier
John Walkenbach, (N°1267)
Sur Mac, je voudrais sélectionner un répertoire en appellant la boite de dialogue appropriée.
Cette macro fonctionne sur mac (xl98) et PC (xl97)
Sub LectureChoix()
Dim Sep As String, OS As String, i As Integer, Car As String, Chemin As String
DocChoisi = Application.GetOpenFilename
If DocChoisi = "False" Or DocChoisi = "Faux" Then
End
End If
OS = Application.OperatingSystem
Select Case Left(OS, 1)
Case "M"
Sep = ":"
Case "W"
Sep = "\"
End Select
i = 0
Do While Car <> Sep
i = i + 1
Car = Left(Right(DocChoisi, i), 1)
Loop
Chemin = Left(DocChoisi, Len(DocChoisi) - i)
End Sub
Sub LectureChoix()
Dim Sep As String, OS As String, i As Integer, Car As String, Chemin As String
DocChoisi = Application.GetOpenFilename
If DocChoisi = "False" Or DocChoisi = "Faux" Then
End
End If
OS = Application.OperatingSystem
Select Case Left(OS, 1)
Case "M"
Sep = ":"
Case "W"
Sep = "\"
End Select
i = 0
Do While Car <> Sep
i = i + 1
Car = Left(Right(DocChoisi, i), 1)
Loop
Chemin = Left(DocChoisi, Len(DocChoisi) - i)
End Sub
Michel Gaboly,
Ajouté ou modifié le 03/09/2004 (N°1266)
Ajouté ou modifié le 03/09/2004 (N°1266)
Comment faire apparaître dans une cellule de la feuille le nom d'un onglet, d'un classeur, d'un répertoire ...?
attention toutes les formules doivent être sur une seule ligne
1. Chemin d'accès complet :
=CELLULE("filename";A1)
2. Répertoire:
=GAUCHE(CELLULE("filename";A1);TROUVE("[";CELLULE("filename"
A1))-2)
3. Nom du classeur seul:
=STXT(CELLULE("filename";A1);TROUVE("[";CELLULE("filename";A
))+1;SOMME(TROUVE({"[";"]"};
CELLULE("filename";A1))*{-1;1})-1)
4. Nom de la feuille:
=STXT(CELLULE("filename";A1);TROUVE("]";CELLULE("filename";A
))+1;32)
5. Répertoire + classeur:
=SUBSTITUE(GAUCHE(CELLULE("filename";A1);TROUVE("]";
CELLULE("filename";A1))-1);"[";"")
6. Nom du classeur et de la feuille:
=STXT(CELLULE("filename";A1);TROUVE("[";CELLULE("filename";A
));300)
1. Chemin d'accès complet :
=CELLULE("filename";A1)
2. Répertoire:
=GAUCHE(CELLULE("filename";A1);TROUVE("[";CELLULE("filename"
A1))-2)
3. Nom du classeur seul:
=STXT(CELLULE("filename";A1);TROUVE("[";CELLULE("filename";A
))+1;SOMME(TROUVE({"[";"]"};
CELLULE("filename";A1))*{-1;1})-1)
4. Nom de la feuille:
=STXT(CELLULE("filename";A1);TROUVE("]";CELLULE("filename";A
))+1;32)
5. Répertoire + classeur:
=SUBSTITUE(GAUCHE(CELLULE("filename";A1);TROUVE("]";
CELLULE("filename";A1))-1);"[";"")
6. Nom du classeur et de la feuille:
=STXT(CELLULE("filename";A1);TROUVE("[";CELLULE("filename";A
));300)
Laurent Longre, (N°1252)