Comment faire pour que mon classeur s'ouvre toujours sur la page "saisie" ?
Ce classeur est utilisé par plusieurs personnes ayant chacune leur feuille particulière.
Peut-on mettre sur le PC de chacune un raccourci qui ouvrirait directement sur la bonne
feuille ?
Si tu n'as pas la contrainte d'utilisateurs multiples, sans aucun code, si à la fermeture
de ton classeur tu l'enregistres alors qu'il est sur cette page, il se rouvrira sur
celle-ci.
Pour automatiser la chose, tu peux mettre ceci dans le before_close du module
ThisWorkBook
sheets("saisie").range("A1").select.
Maintenant si tu veux personnaliser cette page en fonction de l'utilisateur
La cible du racourci doit être écrite ainsi pour ouvrir le fichier sur la feuille 3
"CheminCompletd'XL" /e3 "CheminCompletduFichierXLS"
Et dans le module ThisWorkBook.
Private Declare Function GetCommandLine$ Lib "Kernel32" Alias "GetCommandLineA" ()
Private Sub Workbook_Open()
Dim CmdLine$, Pos1&
CmdLine = GetCommandLine
Pos1 = InStr(CmdLine, ThisWorkbook.FullName)
If Pos1 <> 0& Then CmdLine = Mid$(CmdLine, 1&, Pos1 - 1&) Else Exit Sub
If Right(CmdLine, 1&) = """" Then Pos1 = 2& Else Pos1 = 1&
CmdLine = Mid$(CmdLine, 1&, Len(CmdLine) - Pos1)
CmdLine = Mid$(CmdLine, InStr(1&, CmdLine, " /e") + 3&, Len(CmdLine) - 1&)
Worksheets(CLng(CmdLine)).Activate
End Sub'AC
de ton classeur tu l'enregistres alors qu'il est sur cette page, il se rouvrira sur
celle-ci.
Pour automatiser la chose, tu peux mettre ceci dans le before_close du module
ThisWorkBook
sheets("saisie").range("A1").select.
Maintenant si tu veux personnaliser cette page en fonction de l'utilisateur
La cible du racourci doit être écrite ainsi pour ouvrir le fichier sur la feuille 3
"CheminCompletd'XL" /e3 "CheminCompletduFichierXLS"
Et dans le module ThisWorkBook.
Private Declare Function GetCommandLine$ Lib "Kernel32" Alias "GetCommandLineA" ()
Private Sub Workbook_Open()
Dim CmdLine$, Pos1&
CmdLine = GetCommandLine
Pos1 = InStr(CmdLine, ThisWorkbook.FullName)
If Pos1 <> 0& Then CmdLine = Mid$(CmdLine, 1&, Pos1 - 1&) Else Exit Sub
If Right(CmdLine, 1&) = """" Then Pos1 = 2& Else Pos1 = 1&
CmdLine = Mid$(CmdLine, 1&, Len(CmdLine) - Pos1)
CmdLine = Mid$(CmdLine, InStr(1&, CmdLine, " /e") + 3&, Len(CmdLine) - 1&)
Worksheets(CLng(CmdLine)).Activate
End Sub'AC
Laurent Longre,
Ajouté ou modifié le 23/04/2005 (N°1616)
Ajouté ou modifié le 23/04/2005 (N°1616)
Comment faire pour venir inscrire dans une liste déroulante les noms de fichiers qui sont dans
un répertoire.
La méthode GetOpenFilename permet d'afficher les fichiers et
d'ouvrir celui que l'on sélectionne
Sub test()
fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen <> False Then
MsgBox "Open " & fileToOpen
End If
End Sub
d'ouvrir celui que l'on sélectionne
Sub test()
fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen <> False Then
MsgBox "Open " & fileToOpen
End If
End Sub
Philippe Tulliez, (N°710)
J'ai besoin d'ouvrir à partir d'une procédure VBA des fichiers. Comment ne le faire que s'ils
sont encore fermés ?
Pour ouvrir des fichiers seulement s'ils sont fermés, tu peux, en utilisant une
fonction personnalisée, vérifier s'ils ne sont pas déjà ouverts. Si c'est bien
le cas, tu les ouvres puis tu peux travailler dessus.
Fonction personnalisée (une parmi d'autres) :
Function DejaOuvert(CheminComplet$) As Boolean
Dim Wbk As Workbook
On Error Resume Next
Set Wbk = Workbooks(Dir$(CheminComplet))
DejaOuvert = Err = 0
Err.Clear
End
Function
*************************************
Exemple d'utilisation :
Sub zaza()
Dim Chemin$, Wbk As Workbook
Chemin = "D:\ 6OfficeVBA\Classeur1.xls"
If Not DejaOuvert(Chemin) Then
Workbooks.Open Chemin
Set Wbk = Workbooks(Dir$(Chemin))
MsgBox Wbk.Name
'etc.
End Sub
Utiliser l'objet Err est une façon simple d'éviter la plupart
des Goto (intention fort louable à mon avis) et ça donne un code très lisible.
Tu pourrais aussi, toujours pour n'ouvrir un classeur que s'il est fermé,
utiliser les propriétés de cet objet directement, sans passer par une fonction
personnalisée (dont le principal avantage est d'être réutilisable si tu dois
tester plusieurs fois si un classeur est ouvert ou non). Par exemple :
Sub zaza2()
Dim Chemin$, Wbk As Workbook
Chemin = "D:\ 6OfficeVBA\Classeur1.xls"
On Error Resume Next
Workbooks(Dir$(Chemin)).Activate
If Err <> 0 Then
Err.Clear
Workbooks.Open Chemin
End If
Set Wbk = Workbooks(Dir$(Chemin))
MsgBox Wbk.Name
'etc.
End Sub
fonction personnalisée, vérifier s'ils ne sont pas déjà ouverts. Si c'est bien
le cas, tu les ouvres puis tu peux travailler dessus.
Fonction personnalisée (une parmi d'autres) :
Function DejaOuvert(CheminComplet$) As Boolean
Dim Wbk As Workbook
On Error Resume Next
Set Wbk = Workbooks(Dir$(CheminComplet))
DejaOuvert = Err = 0
Err.Clear
End
Function
*************************************
Exemple d'utilisation :
Sub zaza()
Dim Chemin$, Wbk As Workbook
Chemin = "D:\ 6OfficeVBA\Classeur1.xls"
If Not DejaOuvert(Chemin) Then
Workbooks.Open Chemin
Set Wbk = Workbooks(Dir$(Chemin))
MsgBox Wbk.Name
'etc.
End Sub
Utiliser l'objet Err est une façon simple d'éviter la plupart
des Goto (intention fort louable à mon avis) et ça donne un code très lisible.
Tu pourrais aussi, toujours pour n'ouvrir un classeur que s'il est fermé,
utiliser les propriétés de cet objet directement, sans passer par une fonction
personnalisée (dont le principal avantage est d'être réutilisable si tu dois
tester plusieurs fois si un classeur est ouvert ou non). Par exemple :
Sub zaza2()
Dim Chemin$, Wbk As Workbook
Chemin = "D:\ 6OfficeVBA\Classeur1.xls"
On Error Resume Next
Workbooks(Dir$(Chemin)).Activate
If Err <> 0 Then
Err.Clear
Workbooks.Open Chemin
End If
Set Wbk = Workbooks(Dir$(Chemin))
MsgBox Wbk.Name
'etc.
End Sub
Frédéric Sigonneau, (N°709)
Avec EXCEL sous Jaguar (MacOS X 10.2.4), il m'est impossible de réouvrir un classeur Excel
contenant des macros dès que ce dernier a été modifié sous EXCEL 2001 sur un Mac sous Mac OS 9
MacOS X est multi-langue et c'est là que le bât blesse en ce qui
concerne le cryptage du classeur Excel: sous Mac OS 9 (Excel 2001),
l'encryptage du classeur créé sous Mac OS X se fait pour le français,
MacOS 9 étant mono-langue. Lorsque l'on tente alors de réouvrir le dit
classeur sous MacOS X (paramétré pour plusieurs langues par défaut -
français, anglais et bien d'autres!), avec Excel V.x, on se trouve
alors devant le problème de la validité du crypatge pour ces
différentes langues. Excel affiche alors le message d'erreur indiquant
que le décryptage ne peut se faire pour ce pays...
Si l'on vient alors dans les "Préférences système" de MacOS X,
"International" et que l'on décoche toutes les langues autres que le
français, après avoir quitté et réouvert une nouvelle session, tout
rentre dans l'ordre: le classeur modifié sous MacOS 9 s'ouvre alors
parfaitement dans MacOS X!
concerne le cryptage du classeur Excel: sous Mac OS 9 (Excel 2001),
l'encryptage du classeur créé sous Mac OS X se fait pour le français,
MacOS 9 étant mono-langue. Lorsque l'on tente alors de réouvrir le dit
classeur sous MacOS X (paramétré pour plusieurs langues par défaut -
français, anglais et bien d'autres!), avec Excel V.x, on se trouve
alors devant le problème de la validité du crypatge pour ces
différentes langues. Excel affiche alors le message d'erreur indiquant
que le décryptage ne peut se faire pour ce pays...
Si l'on vient alors dans les "Préférences système" de MacOS X,
"International" et que l'on décoche toutes les langues autres que le
français, après avoir quitté et réouvert une nouvelle session, tout
rentre dans l'ordre: le classeur modifié sous MacOS 9 s'ouvre alors
parfaitement dans MacOS X!
Vec91,
Ajouté ou modifié le 25/10/2003 (N°708)
Ajouté ou modifié le 25/10/2003 (N°708)
Je voudrais créer un fichier .log à l'ouverture et à la fermeture de mon classeur. Dans ce log
je voudrais inscrire le nom de l'utilisateur (username) la date et l'heure
Dans le module ThisWorkbook de ton classeur:
Private Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Workbook_BeforeClose(Cancel As Boolean)
LogUserAction "Closed"
End Sub
Private Sub Workbook_Open()
LogUserAction "Opened"
End Sub
Function UserName()
Dim S As String, n As Long, Res As Long
S = String$(200, 0): n = 199: Res = GetUserName(S, n)
UserName = UCase(Left(S, n - 1))
End Function
Sub LogUserAction(Action As String)
Dim f As Integer, HistLog As String
HistLog = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)
HistLog = ThisWorkbook.Path & "" & HistLog & ".txt"
f = FreeFile
Open HistLog For Append Shared As #f
Write #f, Format(Now, "yyyy-mm-dd hh:mm:ss"), UserName, Action
Close #f
End Sub
Private Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Workbook_BeforeClose(Cancel As Boolean)
LogUserAction "Closed"
End Sub
Private Sub Workbook_Open()
LogUserAction "Opened"
End Sub
Function UserName()
Dim S As String, n As Long, Res As Long
S = String$(200, 0): n = 199: Res = GetUserName(S, n)
UserName = UCase(Left(S, n - 1))
End Function
Sub LogUserAction(Action As String)
Dim f As Integer, HistLog As String
HistLog = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)
HistLog = ThisWorkbook.Path & "" & HistLog & ".txt"
f = FreeFile
Open HistLog For Append Shared As #f
Write #f, Format(Now, "yyyy-mm-dd hh:mm:ss"), UserName, Action
Close #f
End Sub
Michel Pierron,
Ajouté ou modifié le 25/10/2003 (N°707)
Ajouté ou modifié le 25/10/2003 (N°707)
Comment faire par VBA pour lister tous les classeurs ouverts ?
Sub listeWB()
Dim wb As Workbook
Dim txt As String
For Each wb In Workbooks
txt = txt & wb.Name & vbCrLf
Next wb
MsgBox txt
End Sub
Dim wb As Workbook
Dim txt As String
For Each wb In Workbooks
txt = txt & wb.Name & vbCrLf
Next wb
MsgBox txt
End Sub
Pascal Engelmajer, (N°706)
Peut-on faire une boucle sur tous les fichiers d'un répertoire, même si on ne connait pas les
noms de ceux ci. Genre ouvre moi tous les fichiers *.xls contenus dans le dossier
C:\mescacouilloux ?
Le plus simple c'est d'utiliser FileSearch :
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "C:\Temp"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
Next F
End With
Si le code doit tourner aussi sous Excel 5 ou 95 il y a aussi la
fonction Dir$, mais elle est très lente à l'exécution:
Dim F As String
F = Dir$("C:\Temp\*.xls")
Do Until F = ""
Workbooks.Open F
F = Dir$
Loop
FileSearch n'est pas parfait : pas forcément très rapide (même si
davantage que Dir$) et il comporte quelques bizarreries, je ne sais plus
lesquelles. Idem pour Dir$, en "moins pire". Je pense que le plus
efficace consiste à passer par les fonctions API FindFirstFileA & Cie,
comme dans le code suivant, qui liste dans la feuille active tous les
fichiers XLS présents sur C: *
*************************************************
Option Compare Text
Private Type
FILETIME dwLowDateTime As Long
dwHighDateTime As Long
End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
Private Declare Function
FindFirstFileA Lib "Kernel32" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function
FindNextFileA Lib "Kernel32" (ByVal hFindfile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function
FindClose Lib "Kernel32" (ByVal hFindfile As Long) As Long
Declare Function
GetFileAttributesA Lib "Kernel32" (ByVal lpFileName As String) As Long
Const Masque = "*.xls"
Dim Arr() As String
Dim NbFichiers As Long
Dim FileFindData As WIN32_FIND_DATA
Dim Fichier As String
Sub Test() ReDim Arr(1 To 1)
NbFichiers = 0 Recurse "C:\" Application.ScreenUpdating = False
With Range("A1")
.Resize(NbFichiers) .Value = Application.Transpose(Arr) .Sort [A1]
.EntireColumn.AutoFit
End With
End Sub
Private Sub Recurse(ByVal Chemin As String)
Dim hFindfile As Long h
Findfile = FindFirstFileA(Chemin & "*.*", FileFindData)
If Chemin <> "C:\" Then
FindNextFileA hFindfile, FileFindData
If FindNextFileA(hFindfile, FileFindData) = 0 Then
FindClose hFindfile
Exit Sub
End If
End If
Do Fichier = Chemin & Left$(FileFindData.cFileName, _
InStr(1, FileFindData.cFileName, vbNullChar) - 1)
If GetFileAttributesA(Fichier) And vbDirectory Then
Recurse Fichier & "\"
ElseIf Fichier Like Masque Then
NbFichiers = NbFichiers + 1
ReDim Preserve Arr(1 To NbFichiers)
Arr(NbFichiers) = Fichier
End If
Loop While FindNextFileA(hFindfile, FileFindData) FindClose hFindfile
End Sub
Dim F
With Application.FileSearch
.NewSearch
.LookIn = "C:\Temp"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
Next F
End With
Si le code doit tourner aussi sous Excel 5 ou 95 il y a aussi la
fonction Dir$, mais elle est très lente à l'exécution:
Dim F As String
F = Dir$("C:\Temp\*.xls")
Do Until F = ""
Workbooks.Open F
F = Dir$
Loop
FileSearch n'est pas parfait : pas forcément très rapide (même si
davantage que Dir$) et il comporte quelques bizarreries, je ne sais plus
lesquelles. Idem pour Dir$, en "moins pire". Je pense que le plus
efficace consiste à passer par les fonctions API FindFirstFileA & Cie,
comme dans le code suivant, qui liste dans la feuille active tous les
fichiers XLS présents sur C: *
*************************************************
Option Compare Text
Private Type
FILETIME dwLowDateTime As Long
dwHighDateTime As Long
End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
Private Declare Function
FindFirstFileA Lib "Kernel32" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function
FindNextFileA Lib "Kernel32" (ByVal hFindfile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function
FindClose Lib "Kernel32" (ByVal hFindfile As Long) As Long
Declare Function
GetFileAttributesA Lib "Kernel32" (ByVal lpFileName As String) As Long
Const Masque = "*.xls"
Dim Arr() As String
Dim NbFichiers As Long
Dim FileFindData As WIN32_FIND_DATA
Dim Fichier As String
Sub Test() ReDim Arr(1 To 1)
NbFichiers = 0 Recurse "C:\" Application.ScreenUpdating = False
With Range("A1")
.Resize(NbFichiers) .Value = Application.Transpose(Arr) .Sort [A1]
.EntireColumn.AutoFit
End With
End Sub
Private Sub Recurse(ByVal Chemin As String)
Dim hFindfile As Long h
Findfile = FindFirstFileA(Chemin & "*.*", FileFindData)
If Chemin <> "C:\" Then
FindNextFileA hFindfile, FileFindData
If FindNextFileA(hFindfile, FileFindData) = 0 Then
FindClose hFindfile
Exit Sub
End If
End If
Do Fichier = Chemin & Left$(FileFindData.cFileName, _
InStr(1, FileFindData.cFileName, vbNullChar) - 1)
If GetFileAttributesA(Fichier) And vbDirectory Then
Recurse Fichier & "\"
ElseIf Fichier Like Masque Then
NbFichiers = NbFichiers + 1
ReDim Preserve Arr(1 To NbFichiers)
Arr(NbFichiers) = Fichier
End If
Loop While FindNextFileA(hFindfile, FileFindData) FindClose hFindfile
End Sub
Laurent Longre, (N°705)
Je désire écrire des données dans un fichier sans l'ouvrir. Cette saisie automatisée doit être
manipulée à partir d'un autre classeur.
IL est possible de lire et d'écrire dans un classeur sans l'ouvrir, en utilisant ADO
(ActiveX Data Objects), c'est-à-dire en le considérant comme une base de données.
Quelques adresses pour plus de renseignements :
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q257819
http://www.able-consulting.com/tech.php
http://www.erlandsendata.no/english/vba/adodao/index.php
Et ci-dessous deux procédures récupérée sur le forum anglophone, qui donnent
un exemple des moyens d'accès à un classeur par l'intermédiaire d'une connexion ADO.
Attention, débutants s'abstenir :-)
'============================
'Troy W, mpep
Sub subFilesToProcess_Get()
'''Get the list of files to process from a dialog box presented to the user.
Dim vFilenames As Variant
Dim sFilepath As String
Dim vFile As Variant
vFilenames = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Select Multiple Files To Process", _
MultiSelect:=True)
If TypeName(vFilenames) <> "Boolean" Then
For Each vFile In vFilenames
subExcel_ADOconnect_ODBC sFilename:=CStr(vFile)
Next vFile
End If
End Sub
Sub subExcel_ADOconnect_ODBC(sFilename As String)
'''Must have a reference to: Microsoft ActiveX Data Objects 2.x Library
'''Tools | References from the menubar.
Dim oConn As ADODB.Connection
Dim oRs As ADODB.Recordset
'''Create and open a new ADO Connection using ODBC.
Set oConn = New ADODB.Connection
oConn.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
"FIL=excel 8.0;" & _
"DefaultDir=D:\My Documents\Excel2000\Ado;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5;" & _
"DBQ=" & sFilename & ";"
'''Create the Recordset.
Set oRs = New ADODB.Recordset
'''Open the Recordset using a Named Ranged.
'''oRs.Open "Select * from myRange1", oConn, adOpenStatic,
adLockBatchOptimistic, adCmdText
'''Open the Recordset using an unnamed range.
'''oRs.Open "SELECT * FROM [Sheet1$A1:E10]", _
oConn, adOpenStatic, adLockBatchOptimistic, adCmdText
'''Open the Recordset using just the SheetName (without specifying a range).
oRs.Open "[Sheet1$]", oConn, adOpenStatic, adLockBatchOptimistic,adCmdTable
'''Put your code here to send the data recordset to a database.
'''...
'''As a demo, show the user a snippet of the data.
MsgBox "RecordCount: " & oRs.RecordCount & vbCrLf & _
oRs.Fields(0).Name & ", " & oRs.Fields(1).Name & vbCrLf & _
oRs.Fields(0).Value & ", " & oRs.Fields(1).Value
'''Kill the objects.
Set oRs = Nothing
Set oConn = Nothing
End Sub
(ActiveX Data Objects), c'est-à-dire en le considérant comme une base de données.
Quelques adresses pour plus de renseignements :
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q257819
http://www.able-consulting.com/tech.php
http://www.erlandsendata.no/english/vba/adodao/index.php
Et ci-dessous deux procédures récupérée sur le forum anglophone, qui donnent
un exemple des moyens d'accès à un classeur par l'intermédiaire d'une connexion ADO.
Attention, débutants s'abstenir :-)
'============================
'Troy W, mpep
Sub subFilesToProcess_Get()
'''Get the list of files to process from a dialog box presented to the user.
Dim vFilenames As Variant
Dim sFilepath As String
Dim vFile As Variant
vFilenames = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Select Multiple Files To Process", _
MultiSelect:=True)
If TypeName(vFilenames) <> "Boolean" Then
For Each vFile In vFilenames
subExcel_ADOconnect_ODBC sFilename:=CStr(vFile)
Next vFile
End If
End Sub
Sub subExcel_ADOconnect_ODBC(sFilename As String)
'''Must have a reference to: Microsoft ActiveX Data Objects 2.x Library
'''Tools | References from the menubar.
Dim oConn As ADODB.Connection
Dim oRs As ADODB.Recordset
'''Create and open a new ADO Connection using ODBC.
Set oConn = New ADODB.Connection
oConn.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
"FIL=excel 8.0;" & _
"DefaultDir=D:\My Documents\Excel2000\Ado;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5;" & _
"DBQ=" & sFilename & ";"
'''Create the Recordset.
Set oRs = New ADODB.Recordset
'''Open the Recordset using a Named Ranged.
'''oRs.Open "Select * from myRange1", oConn, adOpenStatic,
adLockBatchOptimistic, adCmdText
'''Open the Recordset using an unnamed range.
'''oRs.Open "SELECT * FROM [Sheet1$A1:E10]", _
oConn, adOpenStatic, adLockBatchOptimistic, adCmdText
'''Open the Recordset using just the SheetName (without specifying a range).
oRs.Open "[Sheet1$]", oConn, adOpenStatic, adLockBatchOptimistic,adCmdTable
'''Put your code here to send the data recordset to a database.
'''...
'''As a demo, show the user a snippet of the data.
MsgBox "RecordCount: " & oRs.RecordCount & vbCrLf & _
oRs.Fields(0).Name & ", " & oRs.Fields(1).Name & vbCrLf & _
oRs.Fields(0).Value & ", " & oRs.Fields(1).Value
'''Kill the objects.
Set oRs = Nothing
Set oConn = Nothing
End Sub
Frédéric Sigonneau, Troy W, (N°704)
Comment ouvrir dans un répertoire le dernier fichier modifié ?
Largement inspiré d'une macro de Frédéric Sigoneau :
Sub dernier_modifie()
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fs = Application.FileSearch
Sheets.Add
With fs
.LookIn = "D:\Divers\excel"
.SearchSubFolders = True
.Execute
For Each f In .FoundFiles
Set File = FSO.GetFile(f)
Range("a1") = File.DateLastModified
Range("b1") = f
Range("a1").Insert Shift:=xlDown
Range("b1").Insert Shift:=xlDown
Next f
End With
Set FSO = Nothing
Set File = Nothing
Range("A1").Delete Shift:=xlUp
Range("b1").Delete Shift:=xlUp
Range(Range("a1"), Range("a1").End(xlDown)).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("b1").Select
plus_recent = ActiveCell
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Workbooks.Open plus_recent
End Sub
Sub dernier_modifie()
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fs = Application.FileSearch
Sheets.Add
With fs
.LookIn = "D:\Divers\excel"
.SearchSubFolders = True
.Execute
For Each f In .FoundFiles
Set File = FSO.GetFile(f)
Range("a1") = File.DateLastModified
Range("b1") = f
Range("a1").Insert Shift:=xlDown
Range("b1").Insert Shift:=xlDown
Next f
End With
Set FSO = Nothing
Set File = Nothing
Range("A1").Delete Shift:=xlUp
Range("b1").Delete Shift:=xlUp
Range(Range("a1"), Range("a1").End(xlDown)).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("b1").Select
plus_recent = ActiveCell
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Workbooks.Open plus_recent
End Sub
Popi, Frédéric Sigonneau, (N°703)
Comment savoir si un fichier Excel, Word ou Powerpoint et déjà utilisé sans ouvrir le fichier ?
Cette fonction devrait faire l'affaire.
Function IsFileOpen(filename As String)
Dim filenum As Integer, Errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
Errnum = Err
On Error GoTo 0
Select Case Errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
End Select
End Function
Function IsFileOpen(filename As String)
Dim filenum As Integer, Errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
Errnum = Err
On Error GoTo 0
Select Case Errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
End Select
End Function
Alain Cros,
Ajouté ou modifié le 25/10/2003 (N°702)
Ajouté ou modifié le 25/10/2003 (N°702)
Si par VBA j'essaie d'ouvrir un classeur déjà ouvert, le seul message d'alerte se trouve dans
la barre des titres avec le nom de fichier qui comporte la mention (lecture seule). Comment
interrompre dans ce cas l'ouverture et afficher un message d'alerte.
Voici une macro et une fonction qui associées permettent de faire ce que tu demandes
en réseau NT avec office 2000
'La Macro ==================================== :
Private Sub CommandButtonOpenDemand_Click()
Dim Msg, Style, Title
If IsFileOpen("P:IT DevelopmentsCommun ToolsDemand.xls") Then
MsgBox "Le classeur demandé est en cours d'utilisation"
Else
MsgBox "Le classeur demandé est disponible"
Workbooks.Open "P:IT DevelopmentsCommun ToolsDemand.xls"
End If
End Sub
'La Fonction ==================================== :
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function
en réseau NT avec office 2000
'La Macro ==================================== :
Private Sub CommandButtonOpenDemand_Click()
Dim Msg, Style, Title
If IsFileOpen("P:IT DevelopmentsCommun ToolsDemand.xls") Then
MsgBox "Le classeur demandé est en cours d'utilisation"
Else
MsgBox "Le classeur demandé est disponible"
Workbooks.Open "P:IT DevelopmentsCommun ToolsDemand.xls"
End If
End Sub
'La Fonction ==================================== :
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function
Frédéric Sigonneau, El-Joker, Thierry Rural, (N°701)
Comment vérifier si un classeur simplex.xls est ouvert et l'ouvrir si ce n'est pas le cas ?
Sub OuvreSiPasOuvert()
' activer le fichier ==> sinon l'ouvrir
On Error Resume Next
Workbooks("simplex.xls").Activate
If Err <> 0 Then
fichier = "c:MesCacouillousSosMpfesimplex.xls"
Workbooks.Open Filename:=fichier
If Err <> 0 Then
MsgBox "Le fichier '" & fichier & "' est introuvable"
End If
End If
End Sub
Tu peux aussi remplacer Windows("simplex.xls").Activate par n=
Windows("simplex.xls").Width si tu veux pas activer la fenêtre
Si ça t'arrive souvent de chercher à savoir si tel ou tel classeur est déjà
ouvert ou non, pourquoi pas une petite fonction dans un coin de ton perso.xls :
Function IsOpen(Classeur$) As Boolean
On Error Resume Next
IsOpen = Not Workbooks(Classeur) Is Nothing
Err.Clear
End Function
Ensuite, dans ton code :
If not IsOpen("Simplex.xls") Then etc.
' activer le fichier ==> sinon l'ouvrir
On Error Resume Next
Workbooks("simplex.xls").Activate
If Err <> 0 Then
fichier = "c:MesCacouillousSosMpfesimplex.xls"
Workbooks.Open Filename:=fichier
If Err <> 0 Then
MsgBox "Le fichier '" & fichier & "' est introuvable"
End If
End If
End Sub
Tu peux aussi remplacer Windows("simplex.xls").Activate par n=
Windows("simplex.xls").Width si tu veux pas activer la fenêtre
Si ça t'arrive souvent de chercher à savoir si tel ou tel classeur est déjà
ouvert ou non, pourquoi pas une petite fonction dans un coin de ton perso.xls :
Function IsOpen(Classeur$) As Boolean
On Error Resume Next
IsOpen = Not Workbooks(Classeur) Is Nothing
Err.Clear
End Function
Ensuite, dans ton code :
If not IsOpen("Simplex.xls") Then etc.
Frédéric Sigonneau, (N°700)
Comment corriger le classeur qui se lance à l'ouverture d'Excel et où se trouve-t-il ?
Contrairement à word, il n'y a pas de classeur par défaut visible dans excel. A l'ouverture,
excel ouvre un nouveau classeur avec ses paramètres prédéfinis. Si tu veux les modifier ouvre
un
nouveau document excel, modifie le nouveau classeur puis enregistre le sous classeur.xlt dans
le dossier XLOUVRIR (dans le dossier de ton profile, application data, microsoft, excel,
excelouvrir ou excelstart...).
excel ouvre un nouveau classeur avec ses paramètres prédéfinis. Si tu veux les modifier ouvre
un
nouveau document excel, modifie le nouveau classeur puis enregistre le sous classeur.xlt dans
le dossier XLOUVRIR (dans le dossier de ton profile, application data, microsoft, excel,
excelouvrir ou excelstart...).
Flo Cabon, Jean-Paul Sabatier, (N°699)