Classeur ouvert sur le reseau

bonjour JLuc,

il y un exemple ici:
http://www.mdf-xlpages.com/modules/smartfaq/faq.php?faqidG

isabelle

Le 2015-04-04 12:09, JLuc69 a écrit :

Bonjour le groupe,
Décidement, quand on veut développer une petite application, on se retrouve avec
des montagnes de questions :oÞ

Je souhaiterais savoir s'il est possible de détecter si un fichier excel est
ouvert sur un poste particulier et de pouvoir récupérer/inscrire des données à
l'interieur de celui ci. Eventuellemnt, sans connaitre le nom du fichier (en
partant du principe qu'un seul fichier est ouvert)

Merci pour vos réponses

isabelle a écrit :
Salut isabelle,
Merci de ta réponse et de ton lien, mais ma problématique n'est pas la
même.

J'ai un fichier excel dont je ne connais pas le nom exact qui est
ouvert sur un PC connu. je voudrais accéder à ce fichier ouvert via le
réseau pour récupérer des données ET en inscrire.

Pour bien cerné ce que je veux, je vais essayer de décrire
l'environnement :

Pour les compétitions de billard, on reçoit un fichier excel prérempli
avec les nom prénom des participants (généralement 12).
Sur ce fichier, sont déjà prévu tous les matchs. Tout ce que l'on a à
faire, c'est faire jouer les matchs et entrer les résultats sur ce
fichier.

Je voudrais mettre en place un système de compteur sur chaque billard
utilisé et pour cela, je le développe sur excel, dans un userform.
Donc j'aurais un pc par billard avec l'appli dessus. Je souhaiterais,
si c'est possible, recupérer les noms prénoms des joueurs à partir du
fichier qui sera ouvert sur le PC principal et, en fin de partie,
inscrire les résultats sur ce même fichier.

Dans mon appli, je vais tenir compte du billard utilisé pour que les
données soit récupérées au bon endroit et déposées aussi dans les
bonnes cellules de la bonne feuile

Voilà, en espérant que je n'es pas été trop brouillon dans mes
explications

:-?

bonjour JLuc,

il y un exemple ici:
http://www.mdf-xlpages.com/modules/smartfaq/faq.php?faqidG

isabelle

Le 2015-04-04 12:09, JLuc69 a écrit :

Bonjour le groupe,
Décidement, quand on veut développer une petite application, on se retrouve
avec
des montagnes de questions :oÞ

Je souhaiterais savoir s'il est possible de détecter si un fichier excel
est
ouvert sur un poste particulier et de pouvoir récupérer/inscrire des
données à
l'interieur de celui ci. Eventuellemnt, sans connaitre le nom du fichier
(en
partant du principe qu'un seul fichier est ouvert)

Merci pour vos réponses

Bonjour,

Pour simplifier la tâche, tu devrais créer un répertoire sur le réseau où il y a un fichier pour
chaque billard. Chaque billard utilise leur fichier respectif pour saisir leur résultat. Chaque
fichier d'Excel doit avoir la même structure organisationnelle des données et utiliser le même nom
pour les onglets des feuilles.

Dans le fichier de compilation, tu crées une macro utilisant "ADO" (Activex Data Object) et en
cliquant sur un bouton, tu importes toutes les données des différents billards. Cette exécution peut
se faire au moment que tu le désires et tu peux répéter cela aussi souvent que tu le désires. Dans
ta question, tu ne définis pas comment tu veux compiler les différents résultats... Une feuille par
billard? On peut même automatiser la mise à jour du fichier en utilisant l'événement "Workbook_Open"
du ThisWorkbook.

Écrire dans un fichier sans l'ouvrir n'est pas une mise tâche. Quand c'est possible, il est
préférable d'importer ces données.

MichD a pensé très fort :

Bonjour,

Pour simplifier la tâche, tu devrais créer un répertoire sur le réseau où il
y a un fichier pour chaque billard. Chaque billard utilise leur fichier
respectif pour saisir leur résultat. Chaque fichier d'Excel doit avoir la
même structure organisationnelle des données et utiliser le même nom pour les
onglets des feuilles.

Dans le fichier de compilation, tu crées une macro utilisant "ADO" (Activex
Data Object) et en cliquant sur un bouton, tu importes toutes les données des
différents billards. Cette exécution peut se faire au moment que tu le
désires et tu peux répéter cela aussi souvent que tu le désires. Dans ta
question, tu ne définis pas comment tu veux compiler les différents
résultats... Une feuille par billard? On peut même automatiser la mise à jour
du fichier en utilisant l'événement "Workbook_Open" du ThisWorkbook.

Écrire dans un fichier sans l'ouvrir n'est pas une mise tâche. Quand c'est
possible, il est préférable d'importer ces données.

Tous les résultats sont mis sur la même feuille du fichier de
destination dans différentes cellules.
Ce que je souhaiterais récupérer, ce sont les informations des joueurs
et pouvoir inscrire les résultats sur cette feuille :
http://hpics.li/29b0371

Désolé, une photo ne suffit pas. Cela prend les 2 classeurs.
Le classeur par département et le classeur de compilation.
Dans le classeur de département, remplis-le avec des pointages
hypothétiques afin de voir vraiment de quoi à l'air les données.

Pour publier les classeurs, utilise le site Cjoint.com. Tu nous retournes
ici l'adresse que tu obtiendras.

Dans son message précédent, MichD a écrit :

Désolé, une photo ne suffit pas. Cela prend les 2 classeurs.
Le classeur par département et le classeur de compilation.
Dans le classeur de département, remplis-le avec des pointages
hypothétiques afin de voir vraiment de quoi à l'air les données.

Pour publier les classeurs, utilise le site Cjoint.com. Tu nous retournes
ici l'adresse que tu obtiendras.

Salut MichD
Merci de te pencher sur mon cas.
Tu trouveras ici : http://www.cjoint.com/data/0DglvR7kmRn.htm, un
fichier utilisé avec la structure et les macros associées.
Généralement, ce fichier nous est envoyé par un responsable des
compétitions du district pré-rempli dans la feuille "Engagements".
Au fur et à mesure de la journée, on rempli la feuille "Résultats" à la
fin de chaque partie. Quand toutes les parties ont été jouées, on
utilise la macro pour les classements via le bouton "Vérification de la
feuille "Résultats".
Les cellules sont protégées pour ne pouvoir compléter que les cellules
laissées de couleur blanche.
L'appli que je fais est donc un compteur qui tournera sur des portables
au pied des billard mais complètement indépendant du fichier joint.
Ce que je souhaite, c'est, avant la partie, récupérer les noms des
joueurs sur la feuille "Engagement" en fonction du numéro du billard,
et en fin de partie, mettre les résultats de la partie dans la feuille
"Résultats" toujours en fonction du numéro de billard ET du tour de
jeu.

Désolé, mais j'ai un temps très limité que je peux consacrer à
ce type de questions. Selon ce que tu veux faire exactement,
cela peut prendre au moins quelques heures à réaliser....
je n'ai pas ce temps-là, mais je te propose ceci si cela peut t'aider!

'------------------------------------------------
Ce que je souhaite, c'est, avant la partie, récupérer les noms des
joueurs sur la feuille "Engagement" en fonction du numéro du billard,
et en fin de partie, mettre les résultats de la partie dans la feuille
"Résultats" toujours en fonction du numéro de billard ET du tour de
jeu.
'------------------------------------------------

Ne perds pas ton temps à tout m'expliquer.

Que veux-tu que la macro fasse?

Supposons que tu veuilles extraire les données de la feuille "Synthèse-Remarques"
de chaque classeur placé dans le même répertoire en supposant que dans tous
les classeurs la feuille porte le même nom et que la structure de la plage à extraire
est identique, je te propose ce type de macro.

Attention, tu dois adapter la valeur des variables selon ton application.

Pour exécuter ce type de macro, tu dois ajouter au projetVBA du classeur
la référence suivante : "Microsoft Data Objects 2.8 library". Pour faire cela,
barre des menus / outils / références / et tu coches la référence indiquée
dans la liste.

ATTENTION : Dans ta feuille "Synthèse-Remarques",
Supprime la ligne 1 et les lignes 22-23. Conserve seulement
les données.

Cette macro devrait fonctionner pour la version Excel 1997 à 2003.
Pour les versions plus récentes d'Excel, il faut modifier
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

Pour adapter cette procédure à ton projet, tu dois définir :

A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est tenu pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas partie du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier Excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy

Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset

'-------------------------------------------
Sub MaRequêteAvecADO()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String, Nb As Long

NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
RangeDest = Range("A:H")

'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$" & RangeDest & "] WHERE Nom IS NOT NULL"

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection

'Récupérer dans un tableau, la liste des
'fichiers Excel du répertoire.

File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------

Function TransposeSpecial2(ByRef Arr As Variant) As Variant

Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)

End Function
'-------------------------------------------

Bien,
MichD, je croix qu'on est aller un peu trop loin par rapport à ma
question de départ.
Ce que j' aurais voulu savoir, c'est uniquement si on peux savoir si,
sur un PC du réseau on peut savoir si une instance d'excel est ouverte
et quel est le fichier ouvert.
Ensuite, si on peut lire et écrire des données sur ce fichier.

MichD avait soumis l'idée :

Désolé, mais j'ai un temps très limité que je peux consacrer à
ce type de questions. Selon ce que tu veux faire exactement,
cela peut prendre au moins quelques heures à réaliser....
je n'ai pas ce temps-là, mais je te propose ceci si cela peut t'aider!

'------------------------------------------------
Ce que je souhaite, c'est, avant la partie, récupérer les noms des
joueurs sur la feuille "Engagement" en fonction du numéro du billard,
et en fin de partie, mettre les résultats de la partie dans la feuille
"Résultats" toujours en fonction du numéro de billard ET du tour de
jeu.
'------------------------------------------------

Ne perds pas ton temps à tout m'expliquer.

Que veux-tu que la macro fasse?

Supposons que tu veuilles extraire les données de la feuille
"Synthèse-Remarques"
de chaque classeur placé dans le même répertoire en supposant que dans tous
les classeurs la feuille porte le même nom et que la structure de la plage à
extraire
est identique, je te propose ce type de macro.

Attention, tu dois adapter la valeur des variables selon ton application.

Pour exécuter ce type de macro, tu dois ajouter au projetVBA du classeur
la référence suivante : "Microsoft Data Objects 2.8 library". Pour faire
cela,
barre des menus / outils / références / et tu coches la référence indiquée
dans la liste.

ATTENTION : Dans ta feuille "Synthèse-Remarques",
Supprime la ligne 1 et les lignes 22-23. Conserve seulement
les données.

Cette macro devrait fonctionner pour la version Excel 1997 à 2003.
Pour les versions plus récentes d'Excel, il faut modifier
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

Pour adapter cette procédure à ton projet, tu dois définir :

A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est tenu pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas partie du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier Excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy

Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset

'-------------------------------------------
Sub MaRequêteAvecADO()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String, Nb As Long

NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
RangeDest = Range("A:H")

'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$" & RangeDest & "] WHERE Nom IS
NOT NULL"

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection

'Récupérer dans un tableau, la liste des
'fichiers Excel du répertoire.

File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------

Function TransposeSpecial2(ByRef Arr As Variant) As Variant

Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)

End Function
'-------------------------------------------

Tu peux alors essayer d'adapter ceci :

Dans l'exemple le bouton d'ouverture de "Demand.xls" lance la macro
"CallDemands"

C'est radical! si le fichier est ouvert = Message (et il s'ouvre pas) sinon
il s'ouvre.

'------------------------------------------------------
Sub CallDemands()
Dim Msg, Style, Title
If IsFileOpen("P:DevelopmentsDemand.xls") Then
MsgBox "File Already in use" & Chr(13) & "Please Try Latter"
Else
Workbooks.Open "P:DevelopmentsDemand.xls"
End If
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
'------------------------------------------------------

Bonjour,

Pour vérifier si un fichier est déjà ouvert sur un réseau...


Écrit par Michel Rameaux la proposition originale de Sigonneau et Cie

'---------------------------------------------------------------------------
Sub DémoOuvrirFichier()

Dim Chemin As String, Chemin2 As String
Dim Fichier As String

' Classeur nécessaire :
Chemin = _
Workbooks("Gestion.xls").Worksheets("Données").Range("A1").Value
Chemin2 = "Suivi"
Fichier = "Données.xls"

'Test de l'existence du fichier et son chemin
Call ExisteFichier(Chemin, Chemin2, Fichier)
If Trouvé = False Then
Call FichierAbsent
'Le Fichier n'existe pas :
'traitement de l 'erreur
GoTo FichierAbsent
Exit Sub
End If

'Test d'Ouverture du classeur
Call OuvrirFichier(Chemin, Chemin2, Fichier)
'Traitement
If Occupé = True Then
GoTo FichierUtilisé ' Traitement de l'erreur
Exit Sub
Else
If OuvertLocal = True Then
MsgBox "Tout va bien, mais le fichier " & _
"est ouvert localement"
Exit Sub
Else
MsgBox "Tout va bien. On ouvre le fichier"
End If
End If
Exit Sub
FichierAbsent:
' Placer ici le code
MsgBox "Le fichier n'existe pas"
Exit Sub
FichierUtilisé:
' Placer ici le code
MsgBox "Le fichier n'est pas disponible"
End Sub
'---------------------------------------------------------------------------
Private Function ExisteFichier(Chemin, Chemin2, Fichier) As Boolean

If Dir(Chemin & "" & Chemin2 & "" & Fichier) = "" Then
' Le Fichier n'existe pas
Trouvé = False
Mess = MsgBox("Le dossier - " & UCase(Fichier) & _
" n'existe pas ou a été déplacé." & vbCrLf & vbCrLf & _
"Impossible de continuer.", vbOKOnly, _
"Ouverture des dossiers")
Else
'Le Fichier existe
Trouvé = True
End If
End Function
'-----------------------------------

Private Function OuvrirFichier(Chemin, Chemin2, Fichier) As Boolean

Dim FileNum As Integer, ErrNum As Integer

' Le Fichier est-il déja disponible s
' sur le PC (en local)?
On Error Resume Next
Set W = Workbooks(Fichier)
If Err = 0 Then
Debug.Print Err
'Fichier Ouvert en local
OuvertLocal = True
Exit Function
Else
'Err=9
Debug.Print Err
'Fichier non ouvert en local
OuvertLocal = False
End If

If OuvertLocal = False Then
'Le Fichier n'est pas ouvert localement,
'est-il disponible sur le réseau?
On Error Resume Next
FileNum = FreeFile()
Open (Chemin & "" & Chemin2 & "" & Fichier) _
For Input Lock Read As #FileNum
Close FileNum
ErrNum = Err
On Error GoTo 0
Select Case ErrNum
Case 0
'Fichier non utilisé
Occupé = False
Case 70
'Fichier utilisé
Occupé = True
Mess = MsgBox("Le dossier - " & UCase(Fichier) & _
"n'est pas disponible. Merci de renouveler " & _
"votre demande ultérieurement.", _
vbOKOnly, "Ouverture des dossiers")
Case Else
Error ErrNum
End Select
End If
End Function
'---------------------------------------------------------------------------