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.