Script VBA KO après partage sous Excel

Bonjour,

J'ai souhaite afficher en permanence un planning sur un écran de diffusion.

Le planning est réalisé sous Excel, un script vbs avec du vba le formate sur une vue bien précise de semaine et l'enregistre en HTML. Le script refresh le navigateur pour avoir toujours la dernier version du planning.

Actuellement mon code n'est pas très beau mais fonctionne cela fonctionne.

A présent, je souhaite partager le fichier Excel entre plusieurs reponsable, une fois l'option partagé activé dans Excel, mon script ne fonctionne plus, du moins il n'arrive pas à se postionner sur la vue demandée, j'ai l'intégralité du Excel en HTML.

Pourriez-vous m'aider à peaufiner mon code ?

En vous remerciant.

Voici le script que j'utilise :

Set fso = WScript.CreateObject("Scripting.FileSystemObject")

'
Const xlHtml = 44
Const xlWebArchive = 45
'
' DateSem = "" & DatePart("ww",Now,vbMonday,vbFirstFourDays)
'
LaSemaine = DatePart("ww",Now,vbMonday,vbFirstFourDays)

' Valeur manuelle pour test
' LaSemaine = 50
'
If LaSemaine < 2 Then
ChaineSemaine = "/52/53/1/2/3/"
Actif=3
Else
If LaSemaine > 49 Then
ChaineSemaine = "/49/50/51/52/53/1/"
If LaSemaine = 50 Then
Actif = 2
Else
Actif = 3
End If
Else
ChaineSemaine = "/"&(LaSemaine-1)&"/"&LaSemaine&"/"&(LaSemaine+1)&"/"&(LaSemaine+2)&"/"
Actif=2
End If
End If

' MsgBox(ChaineSemaine)
' Affichage des semaines valides pour debug
'

' Le fichier actuel du planning a été copié avant dans "Z:\Plannings travaux\PLANNING\PLANNING.xls"

'
' Crée une instance d'Excel et ouvre le fichier
'

Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open "Z:\TRAVAUX\Plannings travaux\PLANNING\PLANNING.xls" , , True

' Désactivation des messages d'erreur

objexcel.DisplayAlerts = False

' Boucle sur tous les onglets du fichier
'

For i = objExcel.Sheets.Count-1 to 1 Step -1
objExcel.Sheets(i).Select
On Error Resume Next
If InStr(ChaineSemaine, "/"&objExcel.Sheets(i).Name&"/") = 0 Then
objExcel.Sheets(i).Delete
End If
Next

objExcel.Sheets(Actif).Select

'
' Sauvegarde le fichier courant en HTML soit planning en reel soit ppp
'
'
' objExcel.ActiveWorkbook.SaveAs "Z:\TRAVAUX\Plannings travaux\PLANNING\PLANNING.mhtml", xlWebArchive , , xlLocalSessionChanges
'
objExcel.ActiveWorkbook.SaveAs "Z:\TRAVAUX\Plannings travaux\PLANNING\PLANNING.htm", xlHtml , , xlLocalSessionChanges

' On ferme le fichier Excel
' Et on réactive les messages d'erreur

objExcel.ActiveWorkbook.Close
objExcel.DisplayAlerts = True

'
' fermeture Excel
'
objExcel.Quit