Forcer ouverture lecture seule VBA

[beann]

Bonjour,

Je reprends un message dans une nouvelle conversation parce que le sujet a un peu changé.

J'ai crée un classeur excel qui centralise des données dans le sens où il récupère les données de plusieurs autres classeurs bâtis de la même manière. Mon souci c'est que pour l'importation des données sur le fichier principal en question, cela demande à ouvrir les autres classeurs le temps de la copie et donc qu'ils soient préalablement fermés. Si le classeur est déjà ouvert, j'ai le message suivant:
machintruc.xls est déjà ouvert. Si vous l'ouvrez à nouveau, toutes vos modifications seront perdues. Voulez-vous rouvrir machintruc.xls?

Mais je n'y tiens pas non.

On m'a proposé une solution d'ouverture en lecture seule ce qui serait une très bonne chose. Mais la commande Readonly:=True ajoutée à mon code ne fonctionne pas.

Comment alors forcer l'ouverture de mes fichiers en lecture seule?

Ci-joint, mon code:

Private Sub CommandButton2_Click()
Dim wbk As Workbook, awbk As Workbook
Dim wsh As Worksheet
Dim Fich As String
Dim Ligne As Double
 
Application.ScreenUpdating = False
Set awbk = ThisWorkbook
Set wsh = awbk.Sheets("Donnees regroupees")
 
Fich = Dir("C:\Users\M\Documents\*.xls")

Do While Fich <> ""
    With wsh
        Ligne = .Range("A65536").End(xlUp).Row + 1
        Set wbk = Workbooks.Open("C:\Users\M\Documents\Fla\" & Fich)
        wbk.Sheets("Decompte temps").Range("listeplagesource").Copy.Cells(Ligne, 1)
    
    End With
    wbk.Close False
    Fich = Dir
    Set wbk = Nothing
Loop
Set wsh = Nothing
Set awbk = Nothing
Application.ScreenUpdating = True
End Sub

Et celui proposé qui ne fonctionne pas:

Private Sub CommandButton2_Click()
Dim wbk As Workbook, awbk As Workbook
Dim wsh As Worksheet
Dim Fich As String
Dim Ligne As Double
 
Application.ScreenUpdating = False
Set awbk = ThisWorkbook
Set wsh = awbk.Sheets("Donnees regroupees")
 
Fich = Dir("C:\Users\M\Documents\*.xls")

Do While Fich <> ""
    With wsh
        Ligne = .Range("A65536").End(xlUp).Row + 1
        Set wbk = Workbooks.Open("C:\Users\M\Documents\Fla\" & Fich, [COLOR="Red"]ReadOnly:=True[/COLOR])
        wbk.Sheets("Decompte temps").Range("listeplagesource").Copy.Cells(Ligne, 1)
    
    End With
    wbk.Close False
    Fich = Dir
    Set wbk = Nothing
Loop
Set wsh = Nothing
Set awbk = Nothing
Application.ScreenUpdating = True
End Sub

 

[Guest]

Re : Forcer ouverture lecture seule VBA

Bonjour,

Ajoute cette fonction à ton module:
si le classeur est déjà ouvert,elle le renvoie sinon elle l'ouvre

Function GetWorkBook(strFichier As String) As Workbook
    Dim wk As Workbook
    Dim bOpen As Boolean
   'Parcourir les classeur
    For Each wk In Workbooks
        'Si le classeur est déjà ouvert
        If wk.FullName = strFichier Then
            Set GetWorkBook = wk
            bOpen = True
            Exit For
        End If
    Next
    'Si le classeur n'est pas ouvert
    If Not bOpen Then Set GetWorkBook = Workbooks.Open(strFichier)
End Function

Et dans ta macro change la ligne

 Set wbk = Workbooks.Open("C:\Users\M\Documents\Fla\" & Fich)

Par

Set wbk = GetWorkBook ("C:\Users\M\Documents\Fla\" & Fich)

A+

 

[beann]

Re : Forcer ouverture lecture seule VBA

Tu l'inséres où la fonction dans mon code?
Parce qu'il me demande un "end sub" si je l'insère.

 

[Guest]

Re : Forcer ouverture lecture seule VBA

Re,

J'ai crée un classeur excel....

Cela m'a laissé supposé que tu savais écrire un code VBA.....donne ton niveau en vba lorsque tu fais ce genre de demandes.

La fonction est à coller en dessous de ta macro arpès son End Sub.

A+

 

[beann]

Re : Forcer ouverture lecture seule VBA

Ok, désolé, j'ai un niveau entre débutant et intermédiaire en VBA. Y'a une partie que j'ai crée et une autre bidouillée en recherchant des infos.

Ton code fonctionne mais il ne m'ouvre pas les fichiers en lecture seule. Il m'ouvre les fichiers peu importe qu'ils soient déjà ouverts ou non en le fermant chez celui chez qui il pouvait l'être et sans enregistré les modifs qui auraient pu etre faits. en fait, j'ai l'impression qu'il m'automatise la réponse à la question "machintruc.xls est déjà ouvert. Si vous l'ouvrez à nouveau, toutes vos modifications seront perdues. Voulez-vous rouvrir machintruc.xls?" en renvoyant une réponse positive.

 

[Guest]

Re : Forcer ouverture lecture seule VBA

re,

Les lignes suivantes de ta macro originales:

With wsh
        Ligne = .Range("A65536").End(xlUp).Row + 1
        Set wbk = Workbooks.Open("C:\Users\M\Documents\Fla\" & Fich, [COLOR=red]ReadOnly:=True[/COLOR])
        wbk.Sheets("Decompte temps").Range("listeplagesource").Copy.Cells(Ligne, 1)
    
    End With

Laisse supposer qu'il faut que le classeur soit ouvert pour pouvoir en importer une valeur (d'ailleurs il te manque un espace entre Copy et .Cells) .

La fonction, teste si le classeur est ouvert ou non
Si oui elle le renvoie
Si non elle l'ouvre et le renvoie.
Si tu ne veux pas qu'il se ferme s'il était déjà ouvert on peut faire ceci:

Mettre en tête de module la variable bDejaOuvert as boolean et ré-écrire la fonction de la manière suivante:

Function GetWorkBook(strFichier As String) As Workbook
    Dim wk As Workbook
   [COLOR=red] bOpen = False
[/COLOR]    For Each wk In Workbooks
        If wk.FullName = strFichier Then
            Set GetWorkBook = wk
            [B]bDejaOuvert = True[/B]
            Exit For
        End If
    Next
    If Not [B]bDejaOuvert [/B]Then Set GetWorkBook = Workbooks.Open(strFichier)
End Function

et ensuite dans ta macro:

'S'il le classeur n'était pas ouvert avant l'importation, on le ferme
'sinon il restera ouvert
If Not bDejaOuvert then wbk.Close False

A+

 

[beann]

Re : Forcer ouverture lecture seule VBA

Merci beaucoup. ca fonctionne maintenant.