test fichier ouvert sur réseau

Version imprimable

17/11/2014, 14h00
electrons

test fichier ouvert sur réseau

Bonjour,

J'ai un fichier excel qui utilise des macros via des boutons de commande. Ce dernier fonctionne parfaitement en solo.
Il m'est demandé de le mettre en réseau et de le partager.

Malheureusement, comme prévu par Excel, dès que je le partage, j'ai des messages d'erreur et les macros ne s'exécutent pas normalement.

Auriez-vous une technique (méthode) qui me permettrait d'utiliser ce fichier en réseau?

Merci d'avance pour votre réponse.
17/11/2014, 14h16
Marc-L

Bonjour,

suivre la progression du code en mode pas à pas via la touche F8 tout en contrôlant
le contenu de la fenêtre des Variables locales pour comprendre ce qui ne va pas …

Ne pas oublier non plus en réseau les droits d'accès …
17/11/2014, 14h27
electrons

Bonjour Marc_L

J'ai essayé en mettant un point d'arrêt dans le code mais, en partageant le fichier, il n'en tient pas compte, la macro s'exécute directement et m'affiche le message d'erreur "Erreur d'exécution 1004",ce qui n'arrive pas sans le partage.

Pour le réseau, je ne l'ai pas encore mis sur le réseau, je le teste simplement avec le "Partage"....

Bonjour,

Vous ne pouvez pas modifier la structure du workbook quand il est en mode partagé (ajout/suppression de feuilles, protection, ....) sauf erreur. Est-ce-que votre erreur est lié à une instruction de ce type?

Ci-joint également pour le mode partagé 'vrai' si besoin une fonction qui vous liste les utilisateurs connecté sur le fichier:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Function get_wbk_user(wbk As Workbook) As Variant
'=============================================================================
' List the users sharing the workbook
 
    Subname = "Func: get_wbk_user"
 
    Dim Shartyp As String, cnt_usr As Integer, rownum As Integer
    Dim usr_status() As Variant, users As Variant
 
' Get the users informations
 
    users = wbk.UserStatus
    ReDim usr_status(UBound(users, 1), 3)
 
    usr_status(0, 0) = "User name"
    usr_status(0, 1) = "Date"
 
    For cnt_usr = 1 To UBound(users, 1)
        Select Case users(cnt_usr, 3)
            Case 1
                Shartyp = "Exclusive"
            Case 2
                Shartyp = "Shared"
        End Select
 
            ' Assign to the array for the return
        usr_status(cnt_usr, 0) = users(cnt_usr, 1)
        usr_status(cnt_usr, 1) = DateValue(users(cnt_usr, 2))
        usr_status(cnt_usr, 2) = TimeValue(users(cnt_usr, 2))
        usr_status(cnt_usr, 3) = Shartyp
 
    Next cnt_usr
 
    get_wbk_user = usr_status
 
End Function

et une autre qui vous permet de forcer le mode exclusif, que vous pouvez appelez lors de votre traitement d'erreur si besoin

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub set_wbk_exclusiv()
'=============================================================================
' Set the workbook in exclusive mode, whatever the shared option (sheet 'Usr_setting')
 
    Subname = "set_wbk_exclusiv"
 
    Dim Displ_info As Boolean
    Dim Msgprompt As String, Msganswer As String, Msgwarning As String
    Dim usr_status As Variant, cnt_usr As Integer, colnum As Integer
 
    ThisWorkbook.Activate
    Application.DisplayAlerts = False
 
' INIT, EXIT if already EXCLUSIVE
    If Not (ThisWorkbook.MultiUserEditing) Then Exit Sub
    usr_status = get_wbk_user(ThisWorkbook)
 
'IF SHARED and multi-users, confirm to remove the users
    If ThisWorkbook.MultiUserEditing And UBound(usr_status, 1) > 1 Then
 
        Msgwarning = "User name" & vbTab & "Date" & vbTab & vbTab & "Time" & vbTab & vbTab & "Share type" & vbCrLf
 
        For cnt_usr = 1 To UBound(usr_status, 1)
 
                ' Report the others users
            If usr_status(cnt_usr, 0) <> Application.UserName Then
                For colnum = 0 To 3
                    Msgwarning = Msgwarning & usr_status(cnt_usr, colnum) & vbTab
                Next colnum
                Msgwarning = Msgwarning & vbCrLf
            End If
        Next cnt_usr
 
            ' Confirmation!
        Msgwarning = "The following users will be removed from this file:" & vbCrLf & vbCrLf & Msgwarning
        Msgwarning = Msgwarning & vbCrLf & _
            "They will not be able to save their change, if any!" & vbCrLf & _
            ". OK to continue" & vbCrLf & ". Cancel to ABORT"
        Msganswer = MsgBox(Msgwarning, vbCritical + vbOKCancel, "WARNING: " & Subname)
 
        If Msganswer <> vbOK Then Exit Sub
 
    End If
 
    ThisWorkbook.ExclusiveAccess
 
End Sub

Bonne journée

Bonjour,

Merci pour le code mais cela ne résout pas mon problème.
J'ai trouvé une solution: chaque utilisateur aura le programme excel avec les macros sur son PC et une macro va enregistrer les données dans un fichier excel qui est sur le réseau en l'ouvrant le temps de l'écriture, sauvegarde et fermeture.

Par contre, je teste si le fichier du réseau est ouvert avec le code suivant, ça marche mais le test du fichier en lecture seule ne fonctionne pas.
Mon but est de voir si le fichier est ouvert, alors pas d'enregistrement possible car le fichier sur réseau :
J'essaye d'éviter le message "Un fichier 'xxxx.xls' existe déjà, voulez-vous le remplacer?" et les choix "oui-non-annuler". Ce message arrive uniquement lorsque le fichier est ouvert.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Dim FSO As Scripting.FileSystemObject Dim FileNF As Scripting.File Dim FldNF As Folder 'test si fichier existe If FSO.FileExists(DirNomFichier) Then Set FileNF = FSO.GetFile(DirNomFichier) If FileNF.Attributes And ReadOnly Then MsgBox ("Le fichier est en lecture seule ==> refaire 'Enregistrer' plus tard....") End If DirU = True Else MsgBox ("La connection au 'U' n'est pas faite, connectez-vous puis refaire l''Enregistrement'") Exit Sub End If
et je suis directement en erreur sur le 'If...'

Si vous avez une remarque sur ce code, elle est la bien venue.... :salive: Merci d'avance

19/11/2014, 10h06
vinc_bilb

Bonjour,

Je pense qu'il vous manque l'appel du FSO qui est défini mais non déclaré .... donc non reconnu

Code:

Set FSO = New Scripting.FileSystemObject

Bonjour,

En faisant un copié-collé, j'ai effacé ce code mais il est bien dans la macro, voila plus de code :
On Error GoTo Err

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Dim FSO As Scripting.FileSystemObject
Dim FileNF As Scripting.File
Dim FldNF As Folder
 
Set FSO = New Scripting.FileSystemObject
 
Dim NomFichierCourant As String 'Pour le fichier no fly en cours
Dim NomFichier As String 'Fichier record sur le 'U'
Dim i As Long, DerLine As Long
Dim Cpt As Integer
 
Dim DirFichier As String
Dim DirNomFichier As String
 
Dim NomPatient As String
Dim PrenomPatient As String
 
'Mémorisation feuille active
FeuilleActive = ActiveSheet.Name
 
'Fichier pour enregistrer les données sur le U'
 
DirU = False
NomFichier = "DataNoFly.xls"
DirFichier = "U:\Général\No Fly\"
DirNomFichier = DirFichier + NomFichier
 
'Test si le U est disponible
 
 
If FSO.FileExists(DirNomFichier) Then
 
    'Set FileNF = FSO.GetFile(DirNomFichier)
 
    'If FileNF.A'ttributes And ReadOnly Then
    If FichierEstOuvert(DirNomFichier) Then
 
        MsgBox ("Le fichier est ouvert et en lecture seule ==> refaire 'Enregistrer' plus tard....")
        Exit Sub
 
    Else
 
        DirU = True
 
    End If
 
Else
    MsgBox ("La connection au 'U' n'est pas faite, connectez-vous puis refaire l''Enregistrement'")
 
    Exit Sub
End If
 
Application.ScreenUpdating = False
 
NomFichierCourant = ThisWorkbook.Name
 
Workbooks.Open DirNomFichier
 
Workbooks(NomFichier).Sheets("Record").Unprotect
....

Je suis passé par une fonction pour tester si le fichier est en lecture seule, le

Code:

If FileNF.Attributes And ReadOnly Then

ne fonctionnait pas. J'ai un problème, lorsque j'exécute la macro et que le fichier est ouvert, tout fonctionne bien, mais dés que je ferme le fichier sur le réseau, j'ai un message qui s'affiche me disant que le fichier peut-être ouvert en lecture-écriture, d'ou vient ce message????