Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Fichier partagé

1 réponse
Avatar
IMER09
Bonjour à tous

Sur un PC1 j'ai un fichier X qui a pour particularité de se fermer tous seul
apres 30 mn d'inactivité
Sur un PC2 un autre fichier Y qui a pour source une feuille1 du fichier X du
PC1
A l'ouverture du fichier Y du PC2 j'ouvre le fichier X, dans la procedure
Private Sub Workbook_Open() ,puis, je copie la feuille1 sur une feuille du
fichier Y et je referme le fichier X sans Save.
Par ailleur je ne sais pas pourquoi : La boite de dialogue: Lecture seule
n'apparait jamais, meme si le fichier X est ouvert sur le PC1, de meme que
la boite de diag: Activer les macro n'apparait jamais, mais les macro sont
activé (toute seule apparament)
Sinon J'usqu'ici pas de PB.
Au bout de 30 mn j'ai la fenetre activer les macro du fichier X qui
apparait.
Le fichier X est en train de ce reouvrir alors que je n'est rien demandé
Si j'active les Macro il s'ouvre et se ferme et ne ce reouvre plus cette
fois ci
Il n'y a rien de bien genant en soit j'usqu'ici
Cependant j'ai des pertes d'informations sur mon fichier X a
l'enregistrement, je ne comprend pas pourquoi et je ne vois pas a quelle
moment je les perd
J'ai l'impression que cette reouverture n'est pas neutre dans mon souci

J'espere m'etre bien expliqué, ma dificulté est de determiner d'ou vient le
pb

Code du Fichier X

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Sheets(1).Visible = True
For I = Sheets.Count To 2 Step -1
Sheets(I).Visible = xlVeryHidden
Next I
Application.ScreenUpdating = True
ThisWorkbook.Save
On Error Resume Next
Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False ' annule
événnement
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
On Error Resume Next
Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False
ProchainArret
End Sub

Public HeureArrêt
Sub ProchainArret()
HeureArrêt = Now + TimeValue("00:30:00")
Application.OnTime HeureArrêt, "Fin"
End Sub
Sub Fin()
On Error Resume Next
Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False 'annule
événnement
ThisWorkbook.Close True
End Sub

Code du Fichier Y

Private Sub Workbook_Open()
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
'W = fichier X
Dim W As Range
For Each W In Range("C2")
estouvert = False
For Each fich In Workbooks
If fich.Name = (W.Value) Then estouvert = True
Next
If estouvert = False Then Workbooks.Open (W.Value)

Etc...

Desolé pour la longueur Merci

Rémi

1 réponse

Avatar
IMER09
Re bonsoir
Ma question precedente est un peu compliquée
J'ai trouvé ce qui suit sur excelabo j'ai placé la macro dans this workbook
et la fonction dans un module mais je n'est pas le resultat escompter
Ceci permet normalement d'interompre l'ouverture d'un fichier en lecture
seul
ca resoudrai peut etre mon probleme
J'ai excel 2007

'La Macro ==================================== :
Private Sub CommandButtonOpenDemand_Click()
Dim Msg, Style, Title

If IsFileOpen("P:IT DevelopmentsCommun ToolsDemand.xls") Then
MsgBox "Le classeur demandé est en cours d'utilisation"
Else
MsgBox "Le classeur demandé est disponible"
Workbooks.Open "P:IT DevelopmentsCommun ToolsDemand.xls"
End If
End Sub

'La Fonction ==================================== :
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer

On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function

Merci

Rémi
"IMER09" a écrit dans le message de
news:
Bonjour à tous

Sur un PC1 j'ai un fichier X qui a pour particularité de se fermer tous
seul apres 30 mn d'inactivité
Sur un PC2 un autre fichier Y qui a pour source une feuille1 du fichier X
du PC1
A l'ouverture du fichier Y du PC2 j'ouvre le fichier X, dans la procedure
Private Sub Workbook_Open() ,puis, je copie la feuille1 sur une feuille du
fichier Y et je referme le fichier X sans Save.
Par ailleur je ne sais pas pourquoi : La boite de dialogue: Lecture seule
n'apparait jamais, meme si le fichier X est ouvert sur le PC1, de meme
que la boite de diag: Activer les macro n'apparait jamais, mais les macro
sont activé (toute seule apparament)
Sinon J'usqu'ici pas de PB.
Au bout de 30 mn j'ai la fenetre activer les macro du fichier X qui
apparait.
Le fichier X est en train de ce reouvrir alors que je n'est rien demandé
Si j'active les Macro il s'ouvre et se ferme et ne ce reouvre plus cette
fois ci
Il n'y a rien de bien genant en soit j'usqu'ici
Cependant j'ai des pertes d'informations sur mon fichier X a
l'enregistrement, je ne comprend pas pourquoi et je ne vois pas a quelle
moment je les perd
J'ai l'impression que cette reouverture n'est pas neutre dans mon souci

J'espere m'etre bien expliqué, ma dificulté est de determiner d'ou vient
le pb

Code du Fichier X

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Sheets(1).Visible = True
For I = Sheets.Count To 2 Step -1
Sheets(I).Visible = xlVeryHidden
Next I
Application.ScreenUpdating = True
ThisWorkbook.Save
On Error Resume Next
Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:úlse '
annule événnement
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
On Error Resume Next
Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:úlse
ProchainArret
End Sub

Public HeureArrêt
Sub ProchainArret()
HeureArrêt = Now + TimeValue("00:30:00")
Application.OnTime HeureArrêt, "Fin"
End Sub
Sub Fin()
On Error Resume Next
Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:úlse 'annule
événnement
ThisWorkbook.Close True
End Sub

Code du Fichier Y

Private Sub Workbook_Open()
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
'W = fichier X
Dim W As Range
For Each W In Range("C2")
estouvert = False
For Each fich In Workbooks
If fich.Name = (W.Value) Then estouvert = True
Next
If estouvert = False Then Workbooks.Open (W.Value)

Etc...

Desolé pour la longueur Merci

Rémi