Discussion :

[Titigre]

Bonjour à tous,

J'ai un classeur principal avec mes macro personnalisées, ainsi que plusieurs autres classeurs contenant au moins 2 feuilles chacun.

Je doit copier une de ces feuilles dans mon classeur principal, mettre le ou les classeur(s) source en lecture seule.
Une fois dans mon classeur principal je fait mes modifications sur les données, puis je dois réinsérer les différentes feuilles dans les classeurs sources(en replaçant la feuille source mais pas les autres)

Pour la copie et la lecture seule, pas de problème :

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
48
49
50
51
52
53
54
55
 
Private Sub Importer(strFichier As String, Optional Update As Boolean = False)
 
    Dim Wbk As Workbook
    Dim SH As Worksheet
    Dim onglet As String
    Dim i As Integer, NbLignesCopiees As Integer
 
    'Vérifie qu'il exite un onglet nommé 'ITP' ou demande quel est l'onglet à utiliser
    Set Wbk = Workbooks.Open(strFichier)
    If Not Existe(Wbk, "ITP") Then
        Do
            onglet = InputBox("Veuillez indiquer le nom de l'onglet contenant l'ITP à importer.", "Nom de l'onglet", "ITP")
        Loop Until Existe(Wbk, onglet) = False
        Set SH = Wbk.Worksheets(onglet)
    Else
        Set SH = Wbk.Worksheets("ITP")
    End If
 
    'Copie l'onglet dans le classeur actuel
    If Update = False Then
        Dim str As String
        str = Left(strFichier, InStr(strFichier, ".xls") - 1)
        str = Mid(str, InStrRev(str, "\") + 1)
        If Existe(ThisWorkbook, str) = True Then
            If MsgBox("Cet ITP a déjà été importé. Voulez-vous poursuivre l'importation ?", vbExclamation + vbYesNo, "ITP déjà importé") = vbNo Then
                Wbk.Close False
                Exit Sub
            Else
                Dim nb As Integer
                Dim nom As String
                nb = 0
                Do
                    nb = nb + 1
                    nom = str & "-" & nb
 
                Loop Until Existe(ThisWorkbook, nom) = False
                str = nom
            End If
        End If
        Application.DisplayAlerts = False
        SH.Copy After:=ThisWorkbook.Worksheets("Accueil")
        ThisWorkbook.Worksheets(SH.Name).Name = str
 
        MsgBox "Dernière modification de " & Wbk.Name & " : " _
        & Chr(10) & "Le " & Wbk.BuiltinDocumentProperties("Last save time").value _
        & Chr(10) & "Par " & Wbk.BuiltinDocumentProperties("Last author").value & Chr(10), vbOKOnly + vbInformation, "Dernière modification"
        Application.DisplayAlerts = True
 
    Else
       '[...autre traitement...]
    End If
    Wbk.Application.CutCopyMode = False
    Wbk.Close
End Sub

Mais lorsque je veux modifier le classeur source pour remplacer la feuille source par celle que je viens de modifier... il me bloque sur la lecture seule du fichier. j'ai bien trouvé ce code mais qui apparemment ne fonctionne pas :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Sub LectureSeule(Wbk As String, LectSeule As Boolean)
    'Nécessite d'activer la référence Microsoft Scriping Runtime
    Dim Fs As FileSystemObject
    Dim F As File
 
    Set Fs = CreateObject("Scripting.FileSystemObject")
    Set F = Fs.GetFile(Wbk)
    F.Attributes = F.Attributes + ReadOnly = LectSeule
 
End Sub

et voici mon code pour enregistrer :

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
 
For IntI = Application.Worksheets.Count To 1 Step -1
                Set SR = Worksheets(IntI)
                'Lit le chemin du fichier à modifier
                LectureSeule "c:\toto\classeurtest.xls", False     'Le chemin est un exemple ici mais dans mon code c'est un vrai fichier
                Set Wbk = Application.Workbooks.Open("c:\toto\classeurtest.xls")
 
                'ouvre le bon onglet
                Set SD = Wbk.Worksheets("SRC")
                Application.DisplayAlerts = False
                SD.Delete
                'copie l'onglet
                SR.Copy After:=Wbk.Worksheets(1)
                Wbk.Worksheets(SR.Name).Name = "SRC"                Wbk.BuiltinDocumentProperties("Last author").value = Environ("USERNAME")
                Wbk.Save
                Wbk.Close
        Next IntI

Pouvez-vous m'aider à enlever le ReadOnly provisoirement le temps d'enregistrer la nouvelle feuille ?
Sinon faut-il que je modifie ma façon d'importer la feuille au départ (copie juste des valeurs et de la lise en forme) et dans ce cas comment protéger en lecture seule le ou les classeurs sources ?

Merci d'avance pour votre aide.

[Theze]

Bonjour,

Pour la lecture seule, regarde du coté de "SetAttr" :

Code :

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

1
2
 
SetAttr "D:\Dossier 1\Dossier 2\Classeur1.xls", 0

Hervé.

[Titigre]

Bonjour

Malheureusement cela ne fonctionne pas non plus.

Ce que je ne comprend pas, et si quelqu'un peut m'éclairer sur ce point, pourquoi il me dit que le fichier est ouvert par un autre utilisateur alors que le classeur a été ouvert puis fermé par moi, et qu'il ne veut plus s'ouvrir alors qu'il s'agit toujours de moi, que je n'ai pas changé de session ni rien. Le classeur n'est plus protégé qu'une fois que la feuille correspondante dans mon classeur principal est fermé.

Peut-on connaitre l'utilisateur qui a ouvert le classeur et lui indiquer qu'il s'agit du même qui veut le réouvrir ??? (ce qui doit se faire automatiquement mais ce n'est pas le cas)

Bon ça marche en faisant une petite modification

Lors de l'ouverture pour copier la feuille, j'ouvre en lecture seule, cela n'empêche pas la copie.
Une fois la copie faite et juste avant de fermer le classeur, je met celui-ci en lecture seule avec setattr...


puis avant l'enregistrement des modifications je joue encore avec setattr.
Ce qui donne :

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
48
49
50
51
52
53
54
55
56
57
 
Private Sub Importer(strFichier As String, Optional Update As Boolean = False)
 
    Dim Wbk As Workbook
    Dim SH As Worksheet, SR As Worksheet
    Dim onglet As String
    Dim i As Integer, NbLignesCopiees As Integer
 
    'Vérifie qu'il exite un onglet nommé 'ITP' ou demande quel est l'onglet à utiliser
    Set Wbk = Workbooks.Open(FileName:=strFichier, ReadOnly:=True) '**** ICI la modification de l'ouverture du classeur source *****
    If Not Existe(Wbk, "ITP") Then
        Do
            onglet = InputBox("Veuillez indiquer le nom de l'onglet contenant l'ITP à importer.", "Nom de l'onglet", "ITP")
        Loop Until Existe(Wbk, onglet) = False
        Set SH = Wbk.Worksheets(onglet)
    Else
        Set SH = Wbk.Worksheets("ITP")
    End If
 
    'Copie l'onglet dans le classeur actuel
    If Update = False Then
        Dim str As String
        str = Left(strFichier, InStr(strFichier, ".xls") - 1)
        str = Mid(str, InStrRev(str, "\") + 1)
        If Existe(ThisWorkbook, str) = True Then
            If MsgBox("Cet ITP a déjà été importé. Voulez-vous poursuivre l'importation ?", vbExclamation + vbYesNo, "ITP déjà importé") = vbNo Then
                Wbk.Close False
                Exit Sub
            Else
                Dim nb As Integer
                Dim nom As String
                nb = 0
                Do
                    nb = nb + 1
                    nom = str & "-" & nb
 
                Loop Until Existe(ThisWorkbook, nom) = False
                str = nom
            End If
        End If
        Application.DisplayAlerts = False
 
        SH.Copy After:=ThisWorkbook.Worksheets("Accueil")
        ThisWorkbook.Worksheets(SH.Name).Name = str
 
        Application.DisplayAlerts = True
 
    Else
        '[...Traitement...]
    End If
    Wbk.Application.CutCopyMode = False
 
    'Le classeur source passe en mode readOnly
    SetAttr strFichier, vbReadOnly
 
    Wbk.Close
End Sub

et l'enregistrement :

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
 
'Change le readOnly en mode normal
SetAttr "c:\toto\classeurSource.xls", vbNormal
Set Wbk = Application.Workbooks.Open("c:\toto\classeurSource.xls")
 
'ouvre le bon onglet
Set SD = Wbk.Worksheets("SRC")               
Application.DisplayAlerts = False
SD.Delete
 'copie l'onglet
SR.Copy After:=Wbk.Worksheets(1)
Wbk.Worksheets(SR.Name).Name = "SRC"                Wbk.BuiltinDocumentProperties("Last author").value = Environ("USERNAME")
Wbk.Save
Wbk.Close
Application.DisplayAlerts = True
SetAttr "c:\toto\classeurSource.xls", vbReadOnly

Merci Theze !!!

P.S. : Sais-tu comment faire pour notifier un autre utilisateur que ce fichier est en lecture seule ??? il l'indique uniquement quand il veut l'enregistrer....
En fait vu ce que j'ai fait (je n'ai pas testé la partie ou le fichier est déjà en lecture seule...) Comment notifier l'utilisateur 1 que l'utilisateur veut le fichier OU dire à l'utilisateur 2 "Le fichier est libre vous pouvez enregistrer..."
j'en ai de bonnes questions

[Theze]

Bonsoir,

Regarde du coté de GetAttr (vérifie la valeur retournée) :

Code :

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

1
2
 
MsgBox GetAttr("D:\Dossier 1\Dossier 2\Classeur1.xls")

Hervé.