XL 2013 Code pour ne pas enregistrer et lecture seule automatique[RESOLU]

Etn

XLDnaute Occasionnel
Bonjour,

J'arrive actuellement au bout du périple consistant à consolider des fichiers, et il me reste un dernier problème.

J'utilise le code suivant :

Code:
Private Function ChoisirDossier() As String
 Dim objShell
 Dim objFolder
 Set objShell = CreateObject("Shell.Application")
 Set objFolder = objShell.BrowseForFolder _
     (&H0&, "Sélectionnez un Dossier", &H1&)
 On Error GoTo Erreur
 ChoisirDossier = objFolder.ParentFolder _
     .ParseName(objFolder.Title).Path & ""
 Exit Function
Erreur:
 ChoisirDossier = ""
 End Function

 Sub NOM()

 Dim FSO 'As Scripting.FileSystemObject
 Dim SourceFolder 'As Scripting.Folder
 Dim FileItem 'As Scripting.File
 Dim chemin$
 Dim T()
 Dim cpt&
 Dim g&
 Dim i&
 Dim j&
 Dim Lig&
 Dim var
 Dim WB As Workbook
 Dim S As Worksheet
 Dim DEST As Worksheet
 Dim Info(1 To 1, 1 To 26)
 '------------
 chemin$ = "C:\Downloads"
 If chemin$ = "" Then Exit Sub
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set SourceFolder = FSO.GetFolder(chemin$)
 If SourceFolder.Files.Count = 0 Then Exit Sub
 For Each FileItem In SourceFolder.Files
   If LCase(Right(FileItem.Name, 4)) = ".xls" Or LCase(Right(FileItem.Name, 5)) = ".xlsx" Or LCase(Right(FileItem.Name, 5)) = ".xlsm" Then
     cpt& = cpt& + 1
     ReDim Preserve T(1 To cpt&)
     T(cpt&) = chemin$ & "\" & FileItem.Name
   End If
 Next FileItem
 Set FileItem = Nothing
 Set SourceFolder = Nothing
 Set FSO = Nothing
 '------------
 Application.ScreenUpdating = False
 Set DEST = Sheets.Add
 Lig& = 1
 For g& = 1 To UBound(T)
   Set WB = GetObject(T(g&))
   Set S = WB.Sheets("NOM")
   Info(1, 1) = S.Range("c1")
   Info(1, 2) = S.Range("d35")
   Info(1, 3) = S.Range("d36")
   Info(1, 4) = S.Range("e35")
   Info(1, 5) = S.Range("e36")
   WB.Close
   Set WB = Nothing
   Lig& = Lig& + 1
   DEST.Range(DEST.Cells(Lig&, 1), _
         DEST.Cells(Lig&, UBound(Info, 2))) = Info
   Erase Info
 Next g&
 var = Array("NOM")
 With DEST
   .Range(.Cells(1, 1), .Cells(1, UBound(var) + 1)) = var
   .Range("a1:e1").Interior.ColorIndex = 6
 End With
 Application.ScreenUpdating = False
 Exit Sub
Erreur:
 Application.ScreenUpdating = False
 MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
 End Sub

Le principe est d'ouvrir les fichiers, de reporter les cellules mentionner puis de les refermer.

Le problème est que dans la plupart des fichiers ils s'ouvrent soit en lecture seule (donc un message "Vous lire ce fichier en lecture seule ?" apparait), soit un message apparait pour savoir si on souhaite l'enregistrer quand un fichier se ferme.

Résultat je passe mon temps à cliquer sur Oui et Non. Y aurait il un moyen d'intégrer une ligne ou deux dans le code, permettant ainsi aux fichiers de s'ouvrir et se fermer sans qu'on ait à cliquer à chaque fois ?

Cordialement,

Etn
 
Dernière modification par un modérateur:

thebenoit59

XLDnaute Accro
Re : Code pour ne pas enregistrer et lecture seule automatique

Salut Etn.
Pour fermer ton fichier sans enregistrer tu peux utiliser : WB.Close False.
Pour la lecture seule : ReadOnly: = True. Mais pour le placer correctement avec le GetObject, je ne sais pas vraiment, il aurait fallu que je puisse utiliser ton code.
 

Etn

XLDnaute Occasionnel
Re : Code pour ne pas enregistrer et lecture seule automatique

Salut,

Tout d'abord merci pour ton aide !

J'aurais bien joint les fichiers mais ils sont confidentiels.
Je peux joindre le fichier qui compile mais ça revient juste à faire un copier coller du code dans un fichier vierge.

Je vais essayer de les placer, mais ça va être au bonheur la chance...
 

thebenoit59

XLDnaute Accro
Re : Code pour ne pas enregistrer et lecture seule automatique

Pour le False, ça ne devrait pas poser de problèmes normalement. Pour le ReadOnly, je me demande si tu ne devrais pas le mettre juste après ton GetObject (""").ReadOnly:=True, mais là je ne suis vraiment pas certain.
 

Etn

XLDnaute Occasionnel
Re : Code pour ne pas enregistrer et lecture seule automatique

Le false fonctionne parfaitement merci.

Pour le GetObject j'ai essayé à différents endroits et cela ne fonctionne pas malheureusement

EDIT : Tout fonctionne ! (je viens de voir ton 2e message) Merci beaucoup pour votre aide !!
 
Dernière modification par un modérateur:

Etn

XLDnaute Occasionnel
Re : Code pour ne pas enregistrer et lecture seule automatique[RESOLU]

Aah il reste un dernier message en fait...

"Ce classeur comporte des liaisons avec une ou plusieurs sources externes qui peuvent présenter un risque."

Je voudrais valider "ne pas mettre à jour" automatiquement si possible.
 

Discussions similaires

Statistiques des forums

Discussions
299 847
Messages
1 979 560
Membres
206 772
dernier inscrit
Checopa