Bonjour padbra;
Eh oui, l'affaire se complique car je crois que selon que l'on ouvre un
fichier
directement avec Excel ou au travers de l'explorateur, l'ajout du
raccourci
correspondant dans le dossier Recent ne s'effectue pas au même instant.
Une ouverture avec l'explorateur ajoute le raccourci immédiatement.
Une ouverture avec Excel ajoute le raccourci au moment de la fermeture du
fichier.
Pour que cela marche à tous coups, la procédure 1 est modifiée comme suit:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
Application.DisplayRecentFiles = True
Application.ScreenUpdating = False
Dim objNB As Object: Set objNB = Workbooks.Add
With ThisWorkbook
Open .Path & "xx.bas" For Output As #1
Print #1, "Private Declare Function SHAddToRecentDocs Lib " _
& """Shell32""" & "(ByVal lFlags As Long, ByVal lPv As Long) As Long"
Print #1, "Sub Kill_Link"
Print #1, "SHAddToRecentDocs 2, 0"
Print #1, "Kill " & """" & .Path & "xx.bas" & """"
Print #1, "ThisWorkbook.Close False"
Print #1, "End Sub"
Close #1
objNB.VBProject.VBComponents.Import Filename:=.Path & "xx.bas"
End With
Application.OnTime Now(), objNB.Name & "!Kill_Link"
End Sub
Et la procédure 2 comme suit:
Private Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String _
, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long _
, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As
Long
Private Type ITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ITEMID
End Type
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer, Recent As String, lnkName As String
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
lnkName = GetShortPath(ThisWorkbook.Name)
lnkName = Mid(lnkName, 1, InStr(1, lnkName, "~")) & "1.lnk"
Recent = GetSpecialfolder(&H8) & "" & lnkName
If Dir(Recent) = "" Then Exit Sub
Application.ScreenUpdating = False
Dim objNB As Object: Set objNB = Workbooks.Add
With ThisWorkbook
Open .Path & "xx.bas" For Output As #1
Print #1, "Sub Kill_Link"
Print #1, "Kill " & """" & Recent & """"
Print #1, "Kill " & """" & .Path & "xx.bas" & """"
Print #1, "ThisWorkbook.Close False"
Print #1, "End Sub"
Close #1
objNB.VBProject.VBComponents.Import Filename:=.Path & "xx.bas"
End With
Application.OnTime Now(), objNB.Name & "!Kill_Link"
End Sub
Private Function GetSpecialfolder(CSIDL As Long) As String
On Error GoTo Fin
Dim r As Long, IDL As ITEMIDLIST, Path As String
Path = Space(512)
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
GetSpecialfolder = Left(Path, InStr(Path, Chr(0)) - 1)
Fin:
End Function
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
strPath = String(165, 0)
lngRes = GetShortPathName(strFileName, strPath, 164)
GetShortPath = Left(strPath, lngRes)
End Function
A toi de tester et nous tenir au courant.
MP
"padbra" a écrit dans le message de
news:RE-re
[au temps ?] [autant?] pour moi, d'après ce que je peux en comprendre,
il
s'agit d'une fonction récupérée dans la librairie kernel32 de l'os. Si
elle
est déclarée elle est donc utilisable, me trompe-je ??
Cependant, aucune des deux méthodes ne me donne le résultat escompté.
Que
fais-je de travers ??
padbra
"padbra" a écrit dans le message de news:Re Michel,
Sans vouloir t'embéter, dans la 2éme solution, il me semble qu'il
manque
lafonction "GetShortPathName" :-) que je serai bien incapable de pondre.
Au passage, je note que ce manque ne provoque aucune erreur
d'exécution du
script ??
padbra
"Michel Pierron" a écrit dans le message de
news:
Re padbra;
En fait, j'mas gourré (mille excuses svp); pour supprimer dans la
liste
desfichiers récents, 2 solutions :
Une radicale mais simple (supprime l'intégralité des raccourcis
présents
dans ledossier des fichiers récents)
Private Declare Function SHAddToRecentDocs Lib "Shell32" _
(ByVal lFlags As Long, ByVal lPv As Long) As Long
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call SHAddToRecentDocs(0, 0)
Dim i As Integer
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
End Sub
Une autre plus complexe mais sélective (ne supprime que le raccourci
concerné)Private Declare Function GetShortPathName Lib "kernel32" Alias
"GetShortPathNameA" _
(ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal
lBuffer AsLong) As Long
Private Declare Function SHGetSpecialFolderLocation Lib
"shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As
ITEMIDLIST) As
LongPrivate Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
_
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As
String) As
LongPrivate Type ITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ITEMID
End Type
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer, Recent As String, lnkName As String
lnkName = GetShortPath(ThisWorkbook.Name)
lnkName = Mid(lnkName, 1, InStr(1, lnkName, "~")) & "1.lnk"
Recent = GetSpecialfolder(&H8) & "" & lnkName
If Dir(Recent) <> "" Then Kill Recent
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
End Sub
Private Function GetSpecialfolder(CSIDL As Long) As String
On Error GoTo Fin
Dim r As Long, IDL As ITEMIDLIST, Path As String
Path = Space(512)
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
GetSpecialfolder = Left(Path, InStr(Path, Chr(0)) - 1)
Fin:
End Function
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
strPath = String(165, 0)
lngRes = GetShortPathName(strFileName, strPath, 164)
GetShortPath = Left(strPath, lngRes)
End Function
A toi de choisir.
MP"padbra" a écrit dans le message de
news:uEyVG$Bonjour à tous,
Je repose ma question d'hier, le sujet n'étant p-e pas
suffisamment
explicite :
Au sujet des documents récents :
Comment faire en sorte qu'à la fermeture d'un fichier excel, ce
dernier nese retrouve ni dans la liste des derniers fichiers ouverts dans
excelnidans la liste des documents récents du menu démarrer ?
Merci de vos réponses,
padbra
Bonjour padbra;
Eh oui, l'affaire se complique car je crois que selon que l'on ouvre un
fichier
directement avec Excel ou au travers de l'explorateur, l'ajout du
raccourci
correspondant dans le dossier Recent ne s'effectue pas au même instant.
Une ouverture avec l'explorateur ajoute le raccourci immédiatement.
Une ouverture avec Excel ajoute le raccourci au moment de la fermeture du
fichier.
Pour que cela marche à tous coups, la procédure 1 est modifiée comme suit:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
Application.DisplayRecentFiles = True
Application.ScreenUpdating = False
Dim objNB As Object: Set objNB = Workbooks.Add
With ThisWorkbook
Open .Path & "xx.bas" For Output As #1
Print #1, "Private Declare Function SHAddToRecentDocs Lib " _
& """Shell32""" & "(ByVal lFlags As Long, ByVal lPv As Long) As Long"
Print #1, "Sub Kill_Link"
Print #1, "SHAddToRecentDocs 2, 0"
Print #1, "Kill " & """" & .Path & "xx.bas" & """"
Print #1, "ThisWorkbook.Close False"
Print #1, "End Sub"
Close #1
objNB.VBProject.VBComponents.Import Filename:=.Path & "xx.bas"
End With
Application.OnTime Now(), objNB.Name & "!Kill_Link"
End Sub
Et la procédure 2 comme suit:
Private Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String _
, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long _
, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As
Long
Private Type ITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ITEMID
End Type
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer, Recent As String, lnkName As String
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
lnkName = GetShortPath(ThisWorkbook.Name)
lnkName = Mid(lnkName, 1, InStr(1, lnkName, "~")) & "1.lnk"
Recent = GetSpecialfolder(&H8) & "" & lnkName
If Dir(Recent) = "" Then Exit Sub
Application.ScreenUpdating = False
Dim objNB As Object: Set objNB = Workbooks.Add
With ThisWorkbook
Open .Path & "xx.bas" For Output As #1
Print #1, "Sub Kill_Link"
Print #1, "Kill " & """" & Recent & """"
Print #1, "Kill " & """" & .Path & "xx.bas" & """"
Print #1, "ThisWorkbook.Close False"
Print #1, "End Sub"
Close #1
objNB.VBProject.VBComponents.Import Filename:=.Path & "xx.bas"
End With
Application.OnTime Now(), objNB.Name & "!Kill_Link"
End Sub
Private Function GetSpecialfolder(CSIDL As Long) As String
On Error GoTo Fin
Dim r As Long, IDL As ITEMIDLIST, Path As String
Path = Space(512)
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
GetSpecialfolder = Left(Path, InStr(Path, Chr(0)) - 1)
Fin:
End Function
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
strPath = String(165, 0)
lngRes = GetShortPathName(strFileName, strPath, 164)
GetShortPath = Left(strPath, lngRes)
End Function
A toi de tester et nous tenir au courant.
MP
"padbra" <padbra@suiquapad.bra> a écrit dans le message de
news:uLiiXbU1DHA.2456@TK2MSFTNGP12.phx.gbl...
RE-re
[au temps ?] [autant?] pour moi, d'après ce que je peux en comprendre,
il
s'agit d'une fonction récupérée dans la librairie kernel32 de l'os. Si
elle
est déclarée elle est donc utilisable, me trompe-je ??
Cependant, aucune des deux méthodes ne me donne le résultat escompté.
Que
fais-je de travers ??
padbra
"padbra" <padbra@suiquapad.bra> a écrit dans le message de news:
OjzRoMU1DHA.2156@TK2MSFTNGP12.phx.gbl...
Re Michel,
Sans vouloir t'embéter, dans la 2éme solution, il me semble qu'il
manque
la
fonction "GetShortPathName" :-) que je serai bien incapable de pondre.
Au passage, je note que ce manque ne provoque aucune erreur
d'exécution du
script ??
padbra
"Michel Pierron" <mpierron@europtest.com> a écrit dans le message de
news:
epDsFHU1DHA.3436@tk2msftngp13.phx.gbl...
Re padbra;
En fait, j'mas gourré (mille excuses svp); pour supprimer dans la
liste
des
fichiers récents, 2 solutions :
Une radicale mais simple (supprime l'intégralité des raccourcis
présents
dans le
dossier des fichiers récents)
Private Declare Function SHAddToRecentDocs Lib "Shell32" _
(ByVal lFlags As Long, ByVal lPv As Long) As Long
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call SHAddToRecentDocs(0, 0)
Dim i As Integer
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
End Sub
Une autre plus complexe mais sélective (ne supprime que le raccourci
concerné)
Private Declare Function GetShortPathName Lib "kernel32" Alias
"GetShortPathNameA" _
(ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal
lBuffer As
Long) As Long
Private Declare Function SHGetSpecialFolderLocation Lib
"shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As
ITEMIDLIST) As
Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
_
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As
String) As
Long
Private Type ITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ITEMID
End Type
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer, Recent As String, lnkName As String
lnkName = GetShortPath(ThisWorkbook.Name)
lnkName = Mid(lnkName, 1, InStr(1, lnkName, "~")) & "1.lnk"
Recent = GetSpecialfolder(&H8) & "" & lnkName
If Dir(Recent) <> "" Then Kill Recent
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
End Sub
Private Function GetSpecialfolder(CSIDL As Long) As String
On Error GoTo Fin
Dim r As Long, IDL As ITEMIDLIST, Path As String
Path = Space(512)
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
GetSpecialfolder = Left(Path, InStr(Path, Chr(0)) - 1)
Fin:
End Function
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
strPath = String(165, 0)
lngRes = GetShortPathName(strFileName, strPath, 164)
GetShortPath = Left(strPath, lngRes)
End Function
A toi de choisir.
MP
"padbra" <padbra@suiquapad.bra> a écrit dans le message de
news:uEyVG$R1DHA.1760@TK2MSFTNGP10.phx.gbl...
Bonjour à tous,
Je repose ma question d'hier, le sujet n'étant p-e pas
suffisamment
explicite :
Au sujet des documents récents :
Comment faire en sorte qu'à la fermeture d'un fichier excel, ce
dernier ne
se retrouve ni dans la liste des derniers fichiers ouverts dans
excel
ni
dans la liste des documents récents du menu démarrer ?
Merci de vos réponses,
padbra
Bonjour padbra;
Eh oui, l'affaire se complique car je crois que selon que l'on ouvre un
fichier
directement avec Excel ou au travers de l'explorateur, l'ajout du
raccourci
correspondant dans le dossier Recent ne s'effectue pas au même instant.
Une ouverture avec l'explorateur ajoute le raccourci immédiatement.
Une ouverture avec Excel ajoute le raccourci au moment de la fermeture du
fichier.
Pour que cela marche à tous coups, la procédure 1 est modifiée comme suit:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
Application.DisplayRecentFiles = True
Application.ScreenUpdating = False
Dim objNB As Object: Set objNB = Workbooks.Add
With ThisWorkbook
Open .Path & "xx.bas" For Output As #1
Print #1, "Private Declare Function SHAddToRecentDocs Lib " _
& """Shell32""" & "(ByVal lFlags As Long, ByVal lPv As Long) As Long"
Print #1, "Sub Kill_Link"
Print #1, "SHAddToRecentDocs 2, 0"
Print #1, "Kill " & """" & .Path & "xx.bas" & """"
Print #1, "ThisWorkbook.Close False"
Print #1, "End Sub"
Close #1
objNB.VBProject.VBComponents.Import Filename:=.Path & "xx.bas"
End With
Application.OnTime Now(), objNB.Name & "!Kill_Link"
End Sub
Et la procédure 2 comme suit:
Private Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String _
, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long _
, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As
Long
Private Type ITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ITEMID
End Type
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer, Recent As String, lnkName As String
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
lnkName = GetShortPath(ThisWorkbook.Name)
lnkName = Mid(lnkName, 1, InStr(1, lnkName, "~")) & "1.lnk"
Recent = GetSpecialfolder(&H8) & "" & lnkName
If Dir(Recent) = "" Then Exit Sub
Application.ScreenUpdating = False
Dim objNB As Object: Set objNB = Workbooks.Add
With ThisWorkbook
Open .Path & "xx.bas" For Output As #1
Print #1, "Sub Kill_Link"
Print #1, "Kill " & """" & Recent & """"
Print #1, "Kill " & """" & .Path & "xx.bas" & """"
Print #1, "ThisWorkbook.Close False"
Print #1, "End Sub"
Close #1
objNB.VBProject.VBComponents.Import Filename:=.Path & "xx.bas"
End With
Application.OnTime Now(), objNB.Name & "!Kill_Link"
End Sub
Private Function GetSpecialfolder(CSIDL As Long) As String
On Error GoTo Fin
Dim r As Long, IDL As ITEMIDLIST, Path As String
Path = Space(512)
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
GetSpecialfolder = Left(Path, InStr(Path, Chr(0)) - 1)
Fin:
End Function
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
strPath = String(165, 0)
lngRes = GetShortPathName(strFileName, strPath, 164)
GetShortPath = Left(strPath, lngRes)
End Function
A toi de tester et nous tenir au courant.
MP
"padbra" a écrit dans le message de
news:RE-re
[au temps ?] [autant?] pour moi, d'après ce que je peux en comprendre,
il
s'agit d'une fonction récupérée dans la librairie kernel32 de l'os. Si
elle
est déclarée elle est donc utilisable, me trompe-je ??
Cependant, aucune des deux méthodes ne me donne le résultat escompté.
Que
fais-je de travers ??
padbra
"padbra" a écrit dans le message de news:Re Michel,
Sans vouloir t'embéter, dans la 2éme solution, il me semble qu'il
manque
lafonction "GetShortPathName" :-) que je serai bien incapable de pondre.
Au passage, je note que ce manque ne provoque aucune erreur
d'exécution du
script ??
padbra
"Michel Pierron" a écrit dans le message de
news:
Re padbra;
En fait, j'mas gourré (mille excuses svp); pour supprimer dans la
liste
desfichiers récents, 2 solutions :
Une radicale mais simple (supprime l'intégralité des raccourcis
présents
dans ledossier des fichiers récents)
Private Declare Function SHAddToRecentDocs Lib "Shell32" _
(ByVal lFlags As Long, ByVal lPv As Long) As Long
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call SHAddToRecentDocs(0, 0)
Dim i As Integer
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
End Sub
Une autre plus complexe mais sélective (ne supprime que le raccourci
concerné)Private Declare Function GetShortPathName Lib "kernel32" Alias
"GetShortPathNameA" _
(ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal
lBuffer AsLong) As Long
Private Declare Function SHGetSpecialFolderLocation Lib
"shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As
ITEMIDLIST) As
LongPrivate Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
_
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As
String) As
LongPrivate Type ITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ITEMID
End Type
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer, Recent As String, lnkName As String
lnkName = GetShortPath(ThisWorkbook.Name)
lnkName = Mid(lnkName, 1, InStr(1, lnkName, "~")) & "1.lnk"
Recent = GetSpecialfolder(&H8) & "" & lnkName
If Dir(Recent) <> "" Then Kill Recent
With ThisWorkbook
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
End With
End Sub
Private Function GetSpecialfolder(CSIDL As Long) As String
On Error GoTo Fin
Dim r As Long, IDL As ITEMIDLIST, Path As String
Path = Space(512)
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
GetSpecialfolder = Left(Path, InStr(Path, Chr(0)) - 1)
Fin:
End Function
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
strPath = String(165, 0)
lngRes = GetShortPathName(strFileName, strPath, 164)
GetShortPath = Left(strPath, lngRes)
End Function
A toi de choisir.
MP"padbra" a écrit dans le message de
news:uEyVG$Bonjour à tous,
Je repose ma question d'hier, le sujet n'étant p-e pas
suffisamment
explicite :
Au sujet des documents récents :
Comment faire en sorte qu'à la fermeture d'un fichier excel, ce
dernier nese retrouve ni dans la liste des derniers fichiers ouverts dans
excelnidans la liste des documents récents du menu démarrer ?
Merci de vos réponses,
padbra
Bonjour Michel,
Voici mes tests :
Utilisation de l'évènement "SheetSelectionChange" pour tester c'est moins
fastidieux.
1- petite modification à apporter pour Application.RecentFiles car la
méthode delete modifie le paramètre utilisateur du nombre des derniers
fichiers utilisés, ce qui vide la liste des recentFiles au fur et à mesure
de l'utilisation de ce fichier jusqu'à ne plus rien lister du tout :
With ThisWorkbook
paramUser = Application.RecentFiles.Maximum
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
Application.RecentFiles.Maximum = paramUser
End With
2- Il semble que la méthode GetShortPath ai un soucis
lnkName = GetShortPath(ThisWorkbook.Name)
' tout ce qui suit n'est jamais exécuté excepté la ligne suivante mais excel
n'en reviens jamais :c(
lnkName = Mid(lnkName, 1, InStr(1, lnkName, "~")) & "1.lnk" ' ici un
point d'arret
Recent = GetSpecialfolder(&H8) & "" & lnkName
If Dir(Recent) = "" Then Exit Sub
Application.ScreenUpdating = False
Dim objNB As Object: Set objNB = Workbooks.Add
With ThisWorkbook
Open .Path & "xx.bas" For Output As #1
Print #1, "Sub Kill_Link"
Print #1, "Kill " & """" & Recent & """"
Print #1, "Kill " & """" & .Path & "xx.bas" & """"
Print #1, "ThisWorkbook.Close False"
Print #1, "End Sub"
Close #1
objNB.VBProject.VBComponents.Import Filename:=.Path & "xx.bas"
End With
Application.OnTime Now(), objNB.Name & "!Kill_Link"
End Sub
Au niveau de ;
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
strPath = String(165, 0)
lngRes = GetShortPathName(strFileName, strPath, 164)
'la ligne suivante n'est jamais exécuté
GetShortPath = Left(strPath, lngRes) ' ici un point d'arrêt
End Function
le problème se situerai donc au niveau de la ligne :
lngRes = GetShortPathName(strFileName, strPath, 164)
car excel arrive jusque là mais n'en reviens jamais :c(
Je désactive la partie concernant la function GetShortPath pour tester le
reste du script
Private Function GetSpecialfolder(CSIDL As Long) As String
On Error GoTo Fin
Dim r As Long, IDL As ITEMIDLIST, Path As String
Path = Space(512)
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
GetSpecialfolder = Left(Path, InStr(Path, Chr(0)) - 1)
Fin:
End Function
Il semble qu'excel arrive jusqu'à la ligne
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
mais n'en reviens jamais car le reste du script n'est pas exécuter.
vali vala
bonne journée ;o)
padbra
Bonjour Michel,
Voici mes tests :
Utilisation de l'évènement "SheetSelectionChange" pour tester c'est moins
fastidieux.
1- petite modification à apporter pour Application.RecentFiles car la
méthode delete modifie le paramètre utilisateur du nombre des derniers
fichiers utilisés, ce qui vide la liste des recentFiles au fur et à mesure
de l'utilisation de ce fichier jusqu'à ne plus rien lister du tout :
With ThisWorkbook
paramUser = Application.RecentFiles.Maximum
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
Application.RecentFiles.Maximum = paramUser
End With
2- Il semble que la méthode GetShortPath ai un soucis
lnkName = GetShortPath(ThisWorkbook.Name)
' tout ce qui suit n'est jamais exécuté excepté la ligne suivante mais excel
n'en reviens jamais :c(
lnkName = Mid(lnkName, 1, InStr(1, lnkName, "~")) & "1.lnk" ' ici un
point d'arret
Recent = GetSpecialfolder(&H8) & "" & lnkName
If Dir(Recent) = "" Then Exit Sub
Application.ScreenUpdating = False
Dim objNB As Object: Set objNB = Workbooks.Add
With ThisWorkbook
Open .Path & "xx.bas" For Output As #1
Print #1, "Sub Kill_Link"
Print #1, "Kill " & """" & Recent & """"
Print #1, "Kill " & """" & .Path & "xx.bas" & """"
Print #1, "ThisWorkbook.Close False"
Print #1, "End Sub"
Close #1
objNB.VBProject.VBComponents.Import Filename:=.Path & "xx.bas"
End With
Application.OnTime Now(), objNB.Name & "!Kill_Link"
End Sub
Au niveau de ;
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
strPath = String(165, 0)
lngRes = GetShortPathName(strFileName, strPath, 164)
'la ligne suivante n'est jamais exécuté
GetShortPath = Left(strPath, lngRes) ' ici un point d'arrêt
End Function
le problème se situerai donc au niveau de la ligne :
lngRes = GetShortPathName(strFileName, strPath, 164)
car excel arrive jusque là mais n'en reviens jamais :c(
Je désactive la partie concernant la function GetShortPath pour tester le
reste du script
Private Function GetSpecialfolder(CSIDL As Long) As String
On Error GoTo Fin
Dim r As Long, IDL As ITEMIDLIST, Path As String
Path = Space(512)
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
GetSpecialfolder = Left(Path, InStr(Path, Chr(0)) - 1)
Fin:
End Function
Il semble qu'excel arrive jusqu'à la ligne
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
mais n'en reviens jamais car le reste du script n'est pas exécuter.
vali vala
bonne journée ;o)
padbra
Bonjour Michel,
Voici mes tests :
Utilisation de l'évènement "SheetSelectionChange" pour tester c'est moins
fastidieux.
1- petite modification à apporter pour Application.RecentFiles car la
méthode delete modifie le paramètre utilisateur du nombre des derniers
fichiers utilisés, ce qui vide la liste des recentFiles au fur et à mesure
de l'utilisation de ce fichier jusqu'à ne plus rien lister du tout :
With ThisWorkbook
paramUser = Application.RecentFiles.Maximum
For i = 1 To Application.RecentFiles.Count
If Application.RecentFiles(i).Path = .FullName Then
Application.RecentFiles(i).Delete
Exit For
End If
Next i
Application.RecentFiles.Maximum = paramUser
End With
2- Il semble que la méthode GetShortPath ai un soucis
lnkName = GetShortPath(ThisWorkbook.Name)
' tout ce qui suit n'est jamais exécuté excepté la ligne suivante mais excel
n'en reviens jamais :c(
lnkName = Mid(lnkName, 1, InStr(1, lnkName, "~")) & "1.lnk" ' ici un
point d'arret
Recent = GetSpecialfolder(&H8) & "" & lnkName
If Dir(Recent) = "" Then Exit Sub
Application.ScreenUpdating = False
Dim objNB As Object: Set objNB = Workbooks.Add
With ThisWorkbook
Open .Path & "xx.bas" For Output As #1
Print #1, "Sub Kill_Link"
Print #1, "Kill " & """" & Recent & """"
Print #1, "Kill " & """" & .Path & "xx.bas" & """"
Print #1, "ThisWorkbook.Close False"
Print #1, "End Sub"
Close #1
objNB.VBProject.VBComponents.Import Filename:=.Path & "xx.bas"
End With
Application.OnTime Now(), objNB.Name & "!Kill_Link"
End Sub
Au niveau de ;
Private Function GetShortPath(strFileName As String) As String
Dim lngRes As Long, strPath As String
strPath = String(165, 0)
lngRes = GetShortPathName(strFileName, strPath, 164)
'la ligne suivante n'est jamais exécuté
GetShortPath = Left(strPath, lngRes) ' ici un point d'arrêt
End Function
le problème se situerai donc au niveau de la ligne :
lngRes = GetShortPathName(strFileName, strPath, 164)
car excel arrive jusque là mais n'en reviens jamais :c(
Je désactive la partie concernant la function GetShortPath pour tester le
reste du script
Private Function GetSpecialfolder(CSIDL As Long) As String
On Error GoTo Fin
Dim r As Long, IDL As ITEMIDLIST, Path As String
Path = Space(512)
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path)
GetSpecialfolder = Left(Path, InStr(Path, Chr(0)) - 1)
Fin:
End Function
Il semble qu'excel arrive jusqu'à la ligne
r = SHGetSpecialFolderLocation(0, CSIDL, IDL)
mais n'en reviens jamais car le reste du script n'est pas exécuter.
vali vala
bonne journée ;o)
padbra
