Discussion :

[Souriane]

Bonjour,

Je veux savoir comment ouvrir en VBA un fichier en mode **écriture** lorsqu’il y a l’option « Lecture seule recommandée » dessus.

Je ne parle pas ici de l'attribut que l'on peut changer à partir d'Explorer mais de l'attribut ActiveDocument.ReadOnly (combiné avec ActiveDocument.ReadOnlyRecommended).

Avec un batch, j'ai besoin de faire un "search & replace" régulièrement dans une centaine de fichiers dont la moitié est en mode « Lecture seule recommandée » et je ne veux pas avoir à renommer chaque fichier lors de sa sauvegarde.

Merci pour vos suggestions.

Souriane

[Invité]

Bonjour Souriane,

Tu as un exemple ? En privé si problème.

[Souriane]

Tu as un exemple ?

Ci-joint un document "en lecture seule recommandée"

[Invité]

Ma solution consiste à ouvrir le fichier et à le sauvegarder en tant que fichier provisoire en enlevant l'option Lecture seule recommandée. Ce fichier reste ouvert pour permettre sa modification. A la fermeture, le fichier retrouve son nom d'origine et reprend l'option Lecture seule recommandée.

Ouverture

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
 
Option Explicit
 
Public Repertoire As String, FichierNouveauNom As String, FichierProvisoire As String
 
Sub OuvrirFichierLectureSeuleRecommandee()
 
Dim Fd As FileDialog
Dim VrtSelectedItem As Variant
 
    Repertoire = "C:\Users\Eric\Downloads\"
    FichierNouveauNom = ""
    ChDir Repertoire
    Set Fd = Application.FileDialog(msoFileDialogFilePicker)
 
    With Fd
        If .Show = -1 Then
           For Each VrtSelectedItem In .SelectedItems
               FichierNouveauNom = VrtSelectedItem
           Next VrtSelectedItem
        End If
    End With
 
    If FichierNouveauNom <> "" Then
 
       Select Case LCase(Split(FichierNouveauNom, ".")(1))
              Case "docx"
                   FichierProvisoire = "Fichier provisoire.docx"
              Case "docm"
                    FichierProvisoire = "Fichier provisoire.docm"
       End Select
 
        Documents.Open FileName:=FichierNouveauNom, _
                       ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _
                       PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                       WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                       wdOpenFormatAuto, XMLTransform:=""
        With ActiveDocument
            .ReadOnlyRecommended = False
        End With
        ActiveDocument.SaveAs2 FileName:= _
                               Repertoire & FichierProvisoire, FileFormat:= _
                               wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
                               :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
                               :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
                               SaveAsAOCELetter:=False, CompatibilityMode:=14
 
    End If
 
    Set Fd = Nothing
 
 
End Sub

Fermeture

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
 
Sub FermetureFichierLectureSeuleRecommandee()
 
Dim I As Integer
Dim Continuer As Boolean
 
    Continuer = False
 
    For I = 1 To Documents.Count
        If Documents(I).Name = FichierProvisoire Then Continuer = True
    Next I
 
    If Continuer = True And FichierNouveauNom <> "" Then
 
        Select Case LCase(Split(FichierProvisoire, ".")(1))
              Case "docx"
                   Documents(FichierProvisoire).SaveAs2 FileName:= _
                             FichierNouveauNom, FileFormat:= _
                             wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
                             :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
                             :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
                             SaveAsAOCELetter:=False, CompatibilityMode:=14
              Case "docm"
                   Documents(FichierProvisoire).SaveAs2 FileName:= _
                             FichierNouveauNom, FileFormat:= _
                             wdFormatXMLDocumentMacroEnabled, LockComments:=False, Password:="", AddToRecentFiles _
                             :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
                             :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
                             SaveAsAOCELetter:=False, CompatibilityMode:=14
       End Select
 
       With Documents(FichierNouveauNom)
            .ReadOnlyRecommended = True
            .Close savechanges:=True
       End With
 
    End If
 
 End Sub

[Souriane]

Bonjour,

Merci énormément Éric. J’ai réussi à intégrer les codes que tu m’as donnés à ma macro et ça fonctionne super bien! Je suis enchantée!

Bye!

Souriane!