Sur le site de Fr=E9d=E9ric Sigonneau, j'ai pris les macros suivantes me
permettant d'aller chercher de l'info dans un fichier ferm=E9 de fa=E7on
tr=E8s rapide. Cependant, cela ne fonctionne pas si le fichier est
ouvert.
Ma question est: est-il possible d'aller chercher de l'info sur une
page sp=E9cifique m=EAme si le fichier est ouvert? Voici les instructions
(modifi=E9es pour ma cause) provenant du site de Fr=E9d=E9ric Sigonneau:
Sub LitEmployee()
Dim Msg, Style, Title, Fichier As String
Fichier =3D "V:\Daily Tasks\" & ActiveSheet.Range("B1").Value & ".xls"
'Nom de l'employ=E9 en B1
If IsFileOpen(Fichier) Then
MsgBox "" & ActiveSheet.Range("B1").Value & "'s file is already in
use" & Chr(13) & "Please try later"
Exit Sub
'End If
Dim Fich$, Arr
Fich =3D "V:\Daily Tasks\" & ActiveSheet.Range("B1").Value & ".xls"
'r=E9cup des donn=E9es =E0 partir de l'adresse d'une plage de cellules
GetExternalData Fich, "Daily tasks", "A2:G5000", False, Arr
With ActiveSheet
.Range("A2", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value =3D Arr
End With
End Sub
'Must have the Microsoft Activex Data Objects 2.0 Library
'in the tools----reference---in the VBA section
Sub GetExternalData(srcFile As String, _
srcSheet As String, _
srcRange As String, _
TTL As Boolean, _
outArr As Variant)
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As
Integer
Dim Arr
Set myConn =3D New ADODB.Connection
If TTL =3D True Then HDR =3D "Yes" Else HDR =3D "No"
myConn.Open "Provider=3DMicrosoft.Jet.OLEDB.4.0;" & _
"Data Source=3D" & srcFile & ";" & _
"Extended Properties=3D""Excel 8.0;" & _
"HDR=3D" & HDR & ";IMEX=3D1;"""
Set myCmd =3D New ADODB.Command
myCmd.ActiveConnection =3D myConn
If srcSheet =3D "" _
Then myCmd.CommandText =3D "SELECT * from `" & srcRange & "`" _
Else myCmd.CommandText =3D "SELECT * from `" & srcSheet & "$" &
srcRange & "`"
Set myRS =3D New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n =3D 1 To myRS.RecordCount 'lignes
For RS_f =3D 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) =3D myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS =3D Nothing
Set myCmd =3D Nothing
Set myConn =3D Nothing
outArr =3D Arr
End Sub
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum =3D FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum =3D Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen =3D False
Case 70
IsFileOpen =3D True
Case Else
'Error errnum
End Select
End Function
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichDenis
| Cependant, cela ne fonctionne pas si le fichier est ouvert.
| 'Must have the Microsoft Activex Data Objects 2.0 Library
Si tu as utilisé cette bibliothèque comme indiquée dans ta procédure, effectivement, tu ne peux pas exécuter une requête si le classeur est ouvert. Cependant, c'est un bug bien connu de cette bibliothèque !
Pour solutionner ton problème, si tu as accès à la même bibliothèque du même nom version 2.8, tu n'éprouvera pas ce problème. J'ignore à partir de quelle version, microsoft a corrigé le problème. Tu fais un test en cochant tour à tour une version... tu verras bien.
"Denys" a écrit dans le message de news:
Bonjour à tous,
Sur le site de Frédéric Sigonneau, j'ai pris les macros suivantes me permettant d'aller chercher de l'info dans un fichier fermé de façon très rapide. Cependant, cela ne fonctionne pas si le fichier est ouvert.
Ma question est: est-il possible d'aller chercher de l'info sur une page spécifique même si le fichier est ouvert? Voici les instructions (modifiées pour ma cause) provenant du site de Frédéric Sigonneau:
Sub LitEmployee() Dim Msg, Style, Title, Fichier As String Fichier = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls" 'Nom de l'employé en B1 If IsFileOpen(Fichier) Then MsgBox "" & ActiveSheet.Range("B1").Value & "'s file is already in use" & Chr(13) & "Please try later" Exit Sub 'End If Dim Fich$, Arr Fich = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls"
'récup des données à partir de l'adresse d'une plage de cellules GetExternalData Fich, "Daily tasks", "A2:G5000", False, Arr
With ActiveSheet .Range("A2", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr End With
End Sub
'Must have the Microsoft Activex Data Objects 2.0 Library 'in the tools----reference---in the VBA section Sub GetExternalData(srcFile As String, _ srcSheet As String, _ srcRange As String, _ TTL As Boolean, _ outArr As Variant) Dim myConn As ADODB.Connection, myCmd As ADODB.Command Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer Dim Arr
Set myConn = New ADODB.Connection If TTL = True Then HDR = "Yes" Else HDR = "No" myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & srcFile & ";" & _ "Extended Properties=""Excel 8.0;" & _ "HDR=" & HDR & ";IMEX=1;""" Set myCmd = New ADODB.Command myCmd.ActiveConnection = myConn If srcSheet = "" _ Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _ Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`" Set myRS = New ADODB.Recordset myRS.Open myCmd, , adOpenKeyset, adLockOptimistic ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count) myRS.MoveFirst Do While Not myRS.EOF For RS_n = 1 To myRS.RecordCount 'lignes For RS_f = 0 To myRS.Fields.Count - 1 'colonnes Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value Next myRS.MoveNext Next Loop myConn.Close Set myRS = Nothing Set myCmd = Nothing Set myConn = Nothing
outArr = Arr
End Sub
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
Merci
Denys
| Cependant, cela ne fonctionne pas si le fichier est ouvert.
| 'Must have the Microsoft Activex Data Objects 2.0 Library
Si tu as utilisé cette bibliothèque comme indiquée dans ta procédure,
effectivement, tu ne peux pas exécuter une requête si le classeur est
ouvert. Cependant, c'est un bug bien connu de cette bibliothèque !
Pour solutionner ton problème, si tu as accès à la même bibliothèque
du même nom version 2.8, tu n'éprouvera pas ce problème. J'ignore
à partir de quelle version, microsoft a corrigé le problème. Tu fais
un test en cochant tour à tour une version... tu verras bien.
"Denys" <denys.perreault@rbc.com> a écrit dans le message de news:
1193403058.500515.89200@o80g2000hse.googlegroups.com...
Bonjour à tous,
Sur le site de Frédéric Sigonneau, j'ai pris les macros suivantes me
permettant d'aller chercher de l'info dans un fichier fermé de façon
très rapide. Cependant, cela ne fonctionne pas si le fichier est
ouvert.
Ma question est: est-il possible d'aller chercher de l'info sur une
page spécifique même si le fichier est ouvert? Voici les instructions
(modifiées pour ma cause) provenant du site de Frédéric Sigonneau:
Sub LitEmployee()
Dim Msg, Style, Title, Fichier As String
Fichier = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls"
'Nom de l'employé en B1
If IsFileOpen(Fichier) Then
MsgBox "" & ActiveSheet.Range("B1").Value & "'s file is already in
use" & Chr(13) & "Please try later"
Exit Sub
'End If
Dim Fich$, Arr
Fich = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls"
'récup des données à partir de l'adresse d'une plage de cellules
GetExternalData Fich, "Daily tasks", "A2:G5000", False, Arr
With ActiveSheet
.Range("A2", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr
End With
End Sub
'Must have the Microsoft Activex Data Objects 2.0 Library
'in the tools----reference---in the VBA section
Sub GetExternalData(srcFile As String, _
srcSheet As String, _
srcRange As String, _
TTL As Boolean, _
outArr As Variant)
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As
Integer
Dim Arr
Set myConn = New ADODB.Connection
If TTL = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & srcFile & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = "" _
Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _
Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" &
srcRange & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing
outArr = Arr
End Sub
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
| Cependant, cela ne fonctionne pas si le fichier est ouvert.
| 'Must have the Microsoft Activex Data Objects 2.0 Library
Si tu as utilisé cette bibliothèque comme indiquée dans ta procédure, effectivement, tu ne peux pas exécuter une requête si le classeur est ouvert. Cependant, c'est un bug bien connu de cette bibliothèque !
Pour solutionner ton problème, si tu as accès à la même bibliothèque du même nom version 2.8, tu n'éprouvera pas ce problème. J'ignore à partir de quelle version, microsoft a corrigé le problème. Tu fais un test en cochant tour à tour une version... tu verras bien.
"Denys" a écrit dans le message de news:
Bonjour à tous,
Sur le site de Frédéric Sigonneau, j'ai pris les macros suivantes me permettant d'aller chercher de l'info dans un fichier fermé de façon très rapide. Cependant, cela ne fonctionne pas si le fichier est ouvert.
Ma question est: est-il possible d'aller chercher de l'info sur une page spécifique même si le fichier est ouvert? Voici les instructions (modifiées pour ma cause) provenant du site de Frédéric Sigonneau:
Sub LitEmployee() Dim Msg, Style, Title, Fichier As String Fichier = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls" 'Nom de l'employé en B1 If IsFileOpen(Fichier) Then MsgBox "" & ActiveSheet.Range("B1").Value & "'s file is already in use" & Chr(13) & "Please try later" Exit Sub 'End If Dim Fich$, Arr Fich = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls"
'récup des données à partir de l'adresse d'une plage de cellules GetExternalData Fich, "Daily tasks", "A2:G5000", False, Arr
With ActiveSheet .Range("A2", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr End With
End Sub
'Must have the Microsoft Activex Data Objects 2.0 Library 'in the tools----reference---in the VBA section Sub GetExternalData(srcFile As String, _ srcSheet As String, _ srcRange As String, _ TTL As Boolean, _ outArr As Variant) Dim myConn As ADODB.Connection, myCmd As ADODB.Command Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer Dim Arr
Set myConn = New ADODB.Connection If TTL = True Then HDR = "Yes" Else HDR = "No" myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & srcFile & ";" & _ "Extended Properties=""Excel 8.0;" & _ "HDR=" & HDR & ";IMEX=1;""" Set myCmd = New ADODB.Command myCmd.ActiveConnection = myConn If srcSheet = "" _ Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _ Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`" Set myRS = New ADODB.Recordset myRS.Open myCmd, , adOpenKeyset, adLockOptimistic ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count) myRS.MoveFirst Do While Not myRS.EOF For RS_n = 1 To myRS.RecordCount 'lignes For RS_f = 0 To myRS.Fields.Count - 1 'colonnes Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value Next myRS.MoveNext Next Loop myConn.Close Set myRS = Nothing Set myCmd = Nothing Set myConn = Nothing
outArr = Arr
End Sub
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
Merci
Denys
Denys
Bonjour Denis,
Effectivement, j'y ai acccès...
Merci beaucoup
Bonne fin de semaine
Denys
On 26 oct, 18:48, "MichDenis" wrote:
| Cependant, cela ne fonctionne pas si le fichier est ouvert.
| 'Must have the Microsoft Activex Data Objects 2.0 Library
Si tu as utilisé cette bibliothèque comme indiquée dans ta procéd ure, effectivement, tu ne peux pas exécuter une requête si le classeur est ouvert. Cependant, c'est un bug bien connu de cette bibliothèque !
Pour solutionner ton problème, si tu as accès à la même biblioth èque du même nom version 2.8, tu n'éprouvera pas ce problème. J'ignore à partir de quelle version, microsoft a corrigé le problème. Tu fais un test en cochant tour à tour une version... tu verras bien.
"Denys" a écrit dans le message de news:
Bonjour à tous,
Sur le site de Frédéric Sigonneau, j'ai pris les macros suivantes me permettant d'aller chercher de l'info dans un fichier fermé de façon très rapide. Cependant, cela ne fonctionne pas si le fichier est ouvert.
Ma question est: est-il possible d'aller chercher de l'info sur une page spécifique même si le fichier est ouvert? Voici les instructions (modifiées pour ma cause) provenant du site de Frédéric Sigonneau:
Sub LitEmployee() Dim Msg, Style, Title, Fichier As String Fichier = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls" 'Nom de l'employé en B1 If IsFileOpen(Fichier) Then MsgBox "" & ActiveSheet.Range("B1").Value & "'s file is already in use" & Chr(13) & "Please try later" Exit Sub 'End If Dim Fich$, Arr Fich = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls"
'récup des données à partir de l'adresse d'une plage de cellules GetExternalData Fich, "Daily tasks", "A2:G5000", False, Arr
With ActiveSheet .Range("A2", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr End With
End Sub
'Must have the Microsoft Activex Data Objects 2.0 Library 'in the tools----reference---in the VBA section Sub GetExternalData(srcFile As String, _ srcSheet As String, _ srcRange As String, _ TTL As Boolean, _ outArr As Variant) Dim myConn As ADODB.Connection, myCmd As ADODB.Command Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer Dim Arr
Set myConn = New ADODB.Connection If TTL = True Then HDR = "Yes" Else HDR = "No" myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & srcFile & ";" & _ "Extended Properties=""Excel 8.0;" & _ "HDR=" & HDR & ";IMEX=1;""" Set myCmd = New ADODB.Command myCmd.ActiveConnection = myConn If srcSheet = "" _ Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _ Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`" Set myRS = New ADODB.Recordset myRS.Open myCmd, , adOpenKeyset, adLockOptimistic ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count) myRS.MoveFirst Do While Not myRS.EOF For RS_n = 1 To myRS.RecordCount 'lignes For RS_f = 0 To myRS.Fields.Count - 1 'colonnes Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value Next myRS.MoveNext Next Loop myConn.Close Set myRS = Nothing Set myCmd = Nothing Set myConn = Nothing
outArr = Arr
End Sub
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
Merci
Denys
Bonjour Denis,
Effectivement, j'y ai acccès...
Merci beaucoup
Bonne fin de semaine
Denys
On 26 oct, 18:48, "MichDenis" <michde...@hotmail.com> wrote:
| Cependant, cela ne fonctionne pas si le fichier est ouvert.
| 'Must have the Microsoft Activex Data Objects 2.0 Library
Si tu as utilisé cette bibliothèque comme indiquée dans ta procéd ure,
effectivement, tu ne peux pas exécuter une requête si le classeur est
ouvert. Cependant, c'est un bug bien connu de cette bibliothèque !
Pour solutionner ton problème, si tu as accès à la même biblioth èque
du même nom version 2.8, tu n'éprouvera pas ce problème. J'ignore
à partir de quelle version, microsoft a corrigé le problème. Tu fais
un test en cochant tour à tour une version... tu verras bien.
"Denys" <denys.perrea...@rbc.com> a écrit dans le message de news:
1193403058.500515.89...@o80g2000hse.googlegroups.com...
Bonjour à tous,
Sur le site de Frédéric Sigonneau, j'ai pris les macros suivantes me
permettant d'aller chercher de l'info dans un fichier fermé de façon
très rapide. Cependant, cela ne fonctionne pas si le fichier est
ouvert.
Ma question est: est-il possible d'aller chercher de l'info sur une
page spécifique même si le fichier est ouvert? Voici les instructions
(modifiées pour ma cause) provenant du site de Frédéric Sigonneau:
Sub LitEmployee()
Dim Msg, Style, Title, Fichier As String
Fichier = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls"
'Nom de l'employé en B1
If IsFileOpen(Fichier) Then
MsgBox "" & ActiveSheet.Range("B1").Value & "'s file is already in
use" & Chr(13) & "Please try later"
Exit Sub
'End If
Dim Fich$, Arr
Fich = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls"
'récup des données à partir de l'adresse d'une plage de cellules
GetExternalData Fich, "Daily tasks", "A2:G5000", False, Arr
With ActiveSheet
.Range("A2", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr
End With
End Sub
'Must have the Microsoft Activex Data Objects 2.0 Library
'in the tools----reference---in the VBA section
Sub GetExternalData(srcFile As String, _
srcSheet As String, _
srcRange As String, _
TTL As Boolean, _
outArr As Variant)
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As
Integer
Dim Arr
Set myConn = New ADODB.Connection
If TTL = True Then HDR = "Yes" Else HDR = "No"
myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & srcFile & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & HDR & ";IMEX=1;"""
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = "" _
Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _
Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" &
srcRange & "`"
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing
outArr = Arr
End Sub
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
| Cependant, cela ne fonctionne pas si le fichier est ouvert.
| 'Must have the Microsoft Activex Data Objects 2.0 Library
Si tu as utilisé cette bibliothèque comme indiquée dans ta procéd ure, effectivement, tu ne peux pas exécuter une requête si le classeur est ouvert. Cependant, c'est un bug bien connu de cette bibliothèque !
Pour solutionner ton problème, si tu as accès à la même biblioth èque du même nom version 2.8, tu n'éprouvera pas ce problème. J'ignore à partir de quelle version, microsoft a corrigé le problème. Tu fais un test en cochant tour à tour une version... tu verras bien.
"Denys" a écrit dans le message de news:
Bonjour à tous,
Sur le site de Frédéric Sigonneau, j'ai pris les macros suivantes me permettant d'aller chercher de l'info dans un fichier fermé de façon très rapide. Cependant, cela ne fonctionne pas si le fichier est ouvert.
Ma question est: est-il possible d'aller chercher de l'info sur une page spécifique même si le fichier est ouvert? Voici les instructions (modifiées pour ma cause) provenant du site de Frédéric Sigonneau:
Sub LitEmployee() Dim Msg, Style, Title, Fichier As String Fichier = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls" 'Nom de l'employé en B1 If IsFileOpen(Fichier) Then MsgBox "" & ActiveSheet.Range("B1").Value & "'s file is already in use" & Chr(13) & "Please try later" Exit Sub 'End If Dim Fich$, Arr Fich = "V:Daily Tasks" & ActiveSheet.Range("B1").Value & ".xls"
'récup des données à partir de l'adresse d'une plage de cellules GetExternalData Fich, "Daily tasks", "A2:G5000", False, Arr
With ActiveSheet .Range("A2", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr End With
End Sub
'Must have the Microsoft Activex Data Objects 2.0 Library 'in the tools----reference---in the VBA section Sub GetExternalData(srcFile As String, _ srcSheet As String, _ srcRange As String, _ TTL As Boolean, _ outArr As Variant) Dim myConn As ADODB.Connection, myCmd As ADODB.Command Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer Dim Arr
Set myConn = New ADODB.Connection If TTL = True Then HDR = "Yes" Else HDR = "No" myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & srcFile & ";" & _ "Extended Properties=""Excel 8.0;" & _ "HDR=" & HDR & ";IMEX=1;""" Set myCmd = New ADODB.Command myCmd.ActiveConnection = myConn If srcSheet = "" _ Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _ Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`" Set myRS = New ADODB.Recordset myRS.Open myCmd, , adOpenKeyset, adLockOptimistic ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count) myRS.MoveFirst Do While Not myRS.EOF For RS_n = 1 To myRS.RecordCount 'lignes For RS_f = 0 To myRS.Fields.Count - 1 'colonnes Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value Next myRS.MoveNext Next Loop myConn.Close Set myRS = Nothing Set myCmd = Nothing Set myConn = Nothing
outArr = Arr
End Sub
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
