SaveAs htm - Excel cesse de fonctionner

Version imprimable

Bonjour à tous,

Voici le code mis dans l'objet WorkBook de mon classeur .xlsm
Je veux qu'à l'enregistrement des modifications de ce classeur, une page htm se mette automatiquement à jour (cette page htm est en fait le classeur au format .htm)
Voyez dans le code les 3 problèmes que je rencontre. Je ne comprends pas l'origine du deuxième et je ne sais comment éviter le troisième ... :?
Merci pour votre aide !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FichierDonnees As Workbook
Set FichierDonnees = ActiveWorkbook
 
'Vérification que le répertoire (contenant le fichier) et le fichier à mettre à jour existent bien
    If FolderExist(CheminFichierAffichage) Then
        'Sauvegarde normale d'abord (sinon elle ne se fait pas)
        ActiveWorkbook.Save
        Application.DisplayAlerts = False
        'Mise à jour du fichier html
        FichierDonnees.SaveAs Filename:=CheminFichierAffichage & NomFichierAffichage, _
        FileFormat:=xlHtml, ReadOnlyRecommended:=False, CreateBackup:=False
        Application.DisplayAlerts = True
        '1- Pose problème si l'utilisateur répond non à la question "Voulez-vous remplacer le fichier existant"
        '2- Excel cesse de fonctionner après cette opération lorsque le user accepte le remplacement du fichier existant
        '3- au redémarrage d'Excel (ou directement si Excel ne cesse pas de fonctionner), le fichier html
        '   s'ouvre dans Excel - je ne souhaite pas cette ouverture qui ne sert à rien
    Else
        MsgBox ("Le répertoire suivant n'a pas été trouvé: " & vbNewLine & CheminFichierAffichage)
    End If
End Sub

Devrait répondre à tes trois questions

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub CreerEtSauver()
Const xlHTML = 44
 
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add()
 
objExcel.DisplayAlerts = False
 
objWorkbook.SaveAs "C:\Users\User\Pictures\Test.htm", xlHTML
objworkbook.close
End Sub

Merci EngueEngue pour ta réponse.

J'ai adapté mon code avec la constante xlhtml = 44.
Par contre, je ne vois pas comment utiliser les objets objExcel et objWorkbook.
J'ai déjà Excel ouvert et un classeur bien précis (appelons-le donnees.xlsm) qui est celui à enregistrer tout court et à enregistrer aussi sous donnees.htm.

A noter que toutes les opérations se réalisent bien (les 2 enregistrements se font correctement même si Excel plante).
C'est juste qu'Excel "cesse de fonctionner", souvent le signe d'un mauvais code, mais là je cale.

Ou alors je n'ai pas bien saisi ton code ?

Voici où j'en suis:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim FichierDonnees As Workbook Set FichierDonnees = ActiveWorkbook Const xlHTML = 44 If FolderExist(CheminFichierAffichage) Then Application.DisplayAlerts = False ActiveWorkbook.Save ' La boîte de dialogue "Voulez-vous enregistrer le fichier donnees.xlsm" apparait deux fois (en raison du BeforeSave) FichierDonnees.SaveAs Filename:=CheminFichierAffichage & NomFichierAffichage, _ FileFormat:=xlHTML Application.DisplayAlerts = True FichierDonnees.Close 'Provoque une erreur Mémoire insuffisante Else MsgBox ("Le répertoire suivant n'a pas été trouvé: " & vbNewLine & CheminFichierAffichage) End If End Sub

13/09/2013, 14h56
parmi

Bonjour,

Utilise Dir() pour vérifier si le fichier existe et Kill() pour le détruire avant la sauvegarde s'il existe déjà.

Après un long moment en stand-by, j'ai pu me pencher à nouveau sur ce fichier.
Et merci aux 2 intervenants, car leurs solutions respectives m'ont permis de trouver la solution

Pour ceux qui seraient intéressés, voici le code final:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Public Function FolderExist(ByVal Repertoire As String) As Boolean
    If Len(Dir(Repertoire, vbDirectory)) > 0 Then FolderExist = True
End Function
 
Public Function FileExist(ByVal Chemin As String) As Boolean
    If Len(Dir(Chemin)) > 0 Then FileExist = True
End Function
 
Sub CreerEtSauver()
Const xlHTML = 44
Dim objExcel As Object
Dim objWorkbook As Object
Dim CheminRepertoireWeb As String
Dim NomFichierWeb As String
Dim AdresseFichierWeb As String     
Dim CheminFichierWeb As String
 
CheminRepertoireWeb = "C:\TrucMachin\"
NomFichierWeb = "Bidule"
CheminFichierWeb = CheminRepertoireWeb & NomFichierWeb
AdresseFichierWeb = CheminFichierWeb & ".htm"
 
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
 
'set objworkbook = objExcel.Workbooks.Add()
Set objWorkbook = ActiveWorkbook
 
objExcel.DisplayAlerts = False
 
If FileExist(AdresseFichierWeb) Then
Kill AdresseFichierWeb
End If
 
objWorkbook.SaveAs AdresseFichierWeb, xlHTML
objWorkbook.Close
 
End Sub

Bon, il y a peut-être plus beau, mais ça fonctionne nickel.
Merci donc :ccool: