Discussion :

[electrons]

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.

[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 …

[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"....

[vinc_bilb]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[electrons]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.... Merci d'avance

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Set FSO = New Scripting.FileSystemObject