Mon menu est désactivé et je ne peux pas quitter mon worksheet

Bonjour,

J'ai fait une "base de donnée" avec excel car c'est l'exigence du client et puis en gros, je prend la ligne du haut et je la copie dans une ligne que je viens d'insérer à la ligne 5. Les valeurs de la ligne 1 changeront car elles seront liées par lien DDE. Je ne veux pas que le client ait la permission de modifier quoi que ce soit. Je veux qu'à tous les 15 minutes, enregistrer les valeurs de la ligne 1. J'ai écrit le code ci-dessous et tout fonctionne mais le problème est que lorsque je charge mon fichier excel une première fois, les menus du haut sont inactifs. Par la suite, lorsque je ferme ma fenetre avec le gestionnaire de tâche, il m'est impossible de le ré-ouvrir. Lorsque je double-click sur le fichier, la petite fenetre qui montre le chargement du fichier appairait mais une fois à 100%, il reste figé là et je dois quitter ce pop-op, modifier le nom du fichier et lorsque je le ré-ouvre, il s'ouvre totalement mais l'histoire se répète où je n'ai pas accès au menu, onglet et etc...

Je soupçonne le le while=true mais je ne suis pas certain.

Si c'est le cas comment fait-on pour avoir une boucle fermée, un genre de main() qui se répète?

Quelqu'un aurait une réponse?

---------------------------------------------------------------------------------------------------------
Dim timer1, timer2 As Double
Dim toujours As Boolean
Dim i As Integer
Dim date1 As Integer
Dim mois As Integer

Private Sub Workbook_Activate()

Workactiv

End Sub

Sub Workactiv()

ActiveSheet.Unprotect "Dom45896"

toujours = True
Rows("1").EntireRow.Hidden = True
i = 0
date1 = Month(Now)
timer1 = Timer - 60
timer2 = Timer - (15 * 60)

ActiveSheet.Protect "Dom45896", True, True

While toujours = True

DoEvents

If Timer > timer2 + (15 * 60) Then

ActiveSheet.Unprotect "Dom45896"

'Macro qui insère une ligne et qui met les bordures
Feuil1.Rows("5").EntireRow.Insert
Feuil1.Range("C5:M5").Borders(xlDiagonalDown).LineStyle = xlNone
Feuil1.Range("C5:M5").Borders(xlDiagonalUp).LineStyle = xlNone
With Feuil1.Range("C5:M5").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Feuil1.Range("C5:M5").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Feuil1.Range("C5:M5").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Feuil1.Range("C5:M5").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Feuil1.Range("C5:M5").Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Feuil1.Range("C5:M5").Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

'Copie toutes les cellules du haut pour le mettre dans la ligne insérée
For i = 3 To 13
Feuil1.Cells(5, i) = Feuil1.Cells(1, i)
Next

'Mettre le format d'heure et date comme suit:
Feuil1.Cells(5, 3).NumberFormat = "m/d/yyyy"
Feuil1.Cells(5, 4).NumberFormat = "hh:mm:ss;@"
Feuil2.Cells(6, 3).NumberFormat = "m/d/yyyy"
Feuil2.Cells(7, 3).NumberFormat = "hh:mm:ss;@"


timer2 = Timer

ActiveSheet.Protect "Dom45896", True, True

End If


'Timer prendre les données tous les 15 minutes

If Timer > timer1 + 60 Then

ActiveSheet.Unprotect "Dom45896"

Feuil1.Cells(1, 3) = Date
Feuil1.Cells(1, 4) = Time

'Copie les valeurs des balance de la feuil1 sur la feuil2
'Feuil2.Cells(6, 3) = Feuil1.Cells(1, 3)
'Feuil2.Cells(7, 3) = Feuil1.Cells(1, 4)
'Feuil2.Cells(10, 2) = Feuil1.Cells(1, 5)
'Feuil2.Cells(13, 2) = Feuil1.Cells(1, 6)
'Feuil2.Cells(16, 2) = Feuil1.Cells(1, 7)
'Feuil2.Cells(19, 2) = Feuil1.Cells(1, 8)
'Feuil2.Cells(22, 2) = Feuil1.Cells(1, 9)
'Feuil2.Cells(10, 4) = Feuil1.Cells(1, 10)
'Feuil2.Cells(13, 4) = Feuil1.Cells(1, 11)
'Feuil2.Cells(16, 4) = Feuil1.Cells(1, 12)
'Feuil2.Cells(19, 4) = Feuil1.Cells(1, 13)

'Si mois est différent de janvier, on prend le mois précédent afin de l'enregistrer.


Feuil1.Cells(1, 1) = date1
Feuil1.Cells(1, 2) = Month(Now)
timer1 = Timer

ActiveSheet.Protect "Dom45896", True, True

End If

'Si on est pas au mois de janvier
If Month(Now) <> 1 Then
mois = Month(Now) - 1
'Si on est au mois de janvier
Else
mois = 12
End If

'On engistre dans le dossier BDD sous un format précis aussitot le changement de mois fait.
If i = 1 Then

ActiveSheet.Unprotect "Dom45896"

Application.DisplayAlerts = False
ThisWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveCopyAs "d:\Users\Dominic\Documents\BDD\" & Format(Now(), mois & "_yyyy" & ".xml")
Application.DisplayAlerts = True

Feuil1.Range("5:65536").EntireRow.Borders(xlDiagonalDown).LineStyle = xlNone
Feuil1.Range("5:65536").EntireRow.Borders(xlDiagonalUp).LineStyle = xlNone
Feuil1.Range("5:65536").EntireRow.Borders(xlEdgeLeft).LineStyle = xlNone
Feuil1.Range("5:65536").EntireRow.Borders(xlEdgeTop).LineStyle = xlNone
Feuil1.Range("5:65536").EntireRow.Borders(xlEdgeBottom).LineStyle = xlNone
Feuil1.Range("5:65536").EntireRow.Borders(xlEdgeRight).LineStyle = xlNone
Feuil1.Range("5:65536").EntireRow.Borders(xlInsideVertical).LineStyle = xlNone
Feuil1.Range("5:65536").EntireRow.Borders(xlInsideHorizontal).LineStyle = xlNone
With Feuil1.Range("5:65536").EntireRow.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Feuil1.Range("5:65536").EntireRow.ClearContents
i = 0

ActiveSheet.Protect "Dom45896", True, True

End If
If date1 <> Month(Now) Then
i = 1
date1 = Month(Now)
End If
Wend

End Sub