Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Pilotage Word à partir d'Excel

Pilotage Word à partir d'Excel

4 réponses
Avatar
FxM
Bonsoir,

Je vous soumets un problème lors de la sauvegarde d'un fichier Word
piloté depuis Excel.
Je développe sous Win2000 / Office 2002 et n'ai pas de souci avec le
code ci-dessous. Sur un autre poste WinXP / Office 2003, le fichier Word
reste ouvert au lieu de s'enregistrer et se refermer tout seul.
L'erreur indiquée est :
erreur d'exécution "4248"
Commande non disponible : aucun document n'est ouvert

La ligne suivante est en jaune :
ActiveDocument.SaveAs Filename:=nouveau_nom

Le remplacement de
ActiveDocument.SaveAs Filename:=nouveau_nom
par
Mondoc.SaveAs Filename:=nouveau_nom
donne une erreur 438 chez tous les deux.

Merci pour toute idée et @+
FxM




Voici le code un peu simplifié :
Sub test_lettre(b)
Dim tablo: ReDim tablo(0 To 7, 0 To 1)
Dim ligne As Long, facture As String, lettre As String, MonDoc As
Object, a As Integer
Dim nouveau_nom As String, rep As String

'(snip) ici le tableau de remplacement

nouveau_nom = ActiveWorkbook.Path & "\" & Range("B" & ligne) &
"_Fact-" & Range("J" & ligne) & ".doc"

lettre = ThisWorkbook.Path & "\CF 1 _ 2nd.dot"
Set MonDoc = CreateObject("Word.Application")
With MonDoc
.Documents.Add Template:=lettre, NewTemplate:=False
.Visible = True

With .Selection.Find
'(snip) ici le code de remplacement
End With

If Dir(nouveau_nom) <> "" Then
rep = InputBox(nouveau_nom & " existe dejà." & vbCrLf & "Effacer ->
Tapez 'OK', puis cliquez sur le bouton OK" & vbCrLf & "Sinon, pressez le
bouton 'Annuler'", "Remplacer le fichier ??", "??")
If UCase(rep) = "OK" Then
Application.DisplayAlerts = False
Kill nouveau_nom
Application.DisplayAlerts = True
ActiveDocument.SaveAs Filename:=nouveau_nom
End If
Else
ActiveDocument.SaveAs Filename:=nouveau_nom
End If
.Quit
End With

Set MonDoc = Nothing
End Sub
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
MichDenis
Bonjour FxM,

As-tu essayé quelque chose comme ceci :
Évidemment, tu devrais la compléter ...


'--------------------------
Sub test()

Dim Wd As Object, Dc As Object

Set Wd = CreateObject("word.application")
With Wd
.Visible = True
Set Dc = .Documents.Add(Template:=lettre, NewTemplate:úlse)
'Traitement à effectuer avec le fichier Word
Traitement Dc
Dc.SaveAs "c:toto.doc"
Dc.Close
End With

Wd.Quit
End Sub
'-----------------------------------
Sub Traitement(Dc As Object)
With Dc
MsgBox .Name
End With
End Sub
'--------------------------



"FxM" a écrit dans le message de news:

Bonsoir,

Je vous soumets un problème lors de la sauvegarde d'un fichier Word
piloté depuis Excel.
Je développe sous Win2000 / Office 2002 et n'ai pas de souci avec le
code ci-dessous. Sur un autre poste WinXP / Office 2003, le fichier Word
reste ouvert au lieu de s'enregistrer et se refermer tout seul.
L'erreur indiquée est :
erreur d'exécution "4248"
Commande non disponible : aucun document n'est ouvert

La ligne suivante est en jaune :
ActiveDocument.SaveAs Filename:=nouveau_nom

Le remplacement de
ActiveDocument.SaveAs Filename:=nouveau_nom
par
Mondoc.SaveAs Filename:=nouveau_nom
donne une erreur 438 chez tous les deux.

Merci pour toute idée et @+
FxM




Voici le code un peu simplifié :
Sub test_lettre(b)
Dim tablo: ReDim tablo(0 To 7, 0 To 1)
Dim ligne As Long, facture As String, lettre As String, MonDoc As
Object, a As Integer
Dim nouveau_nom As String, rep As String

'(snip) ici le tableau de remplacement

nouveau_nom = ActiveWorkbook.Path & "" & Range("B" & ligne) &
"_Fact-" & Range("J" & ligne) & ".doc"

lettre = ThisWorkbook.Path & "CF 1 _ 2nd.dot"
Set MonDoc = CreateObject("Word.Application")
With MonDoc
.Documents.Add Template:=lettre, NewTemplate:úlse
.Visible = True

With .Selection.Find
'(snip) ici le code de remplacement
End With

If Dir(nouveau_nom) <> "" Then
rep = InputBox(nouveau_nom & " existe dejà." & vbCrLf & "Effacer ->
Tapez 'OK', puis cliquez sur le bouton OK" & vbCrLf & "Sinon, pressez le
bouton 'Annuler'", "Remplacer le fichier ??", "??")
If UCase(rep) = "OK" Then
Application.DisplayAlerts = False
Kill nouveau_nom
Application.DisplayAlerts = True
ActiveDocument.SaveAs Filename:=nouveau_nom
End If
Else
ActiveDocument.SaveAs Filename:=nouveau_nom
End If
.Quit
End With

Set MonDoc = Nothing
End Sub
Avatar
FxM
Bonjour Denis,

Dire que j'ai tourné autour de ce set dc = ... pour y mettre la
'template' durant un bout de temps sans trouver le bon bout !

J'ai complété, essayé et ça marche chez moi. En attente de confirmation
pour le 2nd poste.

Merci de ta réponse.
FxM


Bonjour FxM,

As-tu essayé quelque chose comme ceci :
Évidemment, tu devrais la compléter ...


'--------------------------
Sub test()

Dim Wd As Object, Dc As Object

Set Wd = CreateObject("word.application")
With Wd
.Visible = True
Set Dc = .Documents.Add(Template:=lettre, NewTemplate:úlse)
'Traitement à effectuer avec le fichier Word
Traitement Dc
Dc.SaveAs "c:toto.doc"
Dc.Close
End With

Wd.Quit
End Sub
'-----------------------------------
Sub Traitement(Dc As Object)
With Dc
MsgBox .Name
End With
End Sub
'--------------------------



"FxM" a écrit dans le message de news:

Bonsoir,

Je vous soumets un problème lors de la sauvegarde d'un fichier Word
piloté depuis Excel.
Je développe sous Win2000 / Office 2002 et n'ai pas de souci avec le
code ci-dessous. Sur un autre poste WinXP / Office 2003, le fichier Word
reste ouvert au lieu de s'enregistrer et se refermer tout seul.
L'erreur indiquée est :
erreur d'exécution "4248"
Commande non disponible : aucun document n'est ouvert

La ligne suivante est en jaune :
ActiveDocument.SaveAs Filename:=nouveau_nom

Le remplacement de
ActiveDocument.SaveAs Filename:=nouveau_nom
par
Mondoc.SaveAs Filename:=nouveau_nom
donne une erreur 438 chez tous les deux.

Merci pour toute idée et @+
FxM




Voici le code un peu simplifié :
Sub test_lettre(b)
Dim tablo: ReDim tablo(0 To 7, 0 To 1)
Dim ligne As Long, facture As String, lettre As String, MonDoc As
Object, a As Integer
Dim nouveau_nom As String, rep As String

'(snip) ici le tableau de remplacement

nouveau_nom = ActiveWorkbook.Path & "" & Range("B" & ligne) &
"_Fact-" & Range("J" & ligne) & ".doc"

lettre = ThisWorkbook.Path & "CF 1 _ 2nd.dot"
Set MonDoc = CreateObject("Word.Application")
With MonDoc
.Documents.Add Template:=lettre, NewTemplate:úlse
.Visible = True

With .Selection.Find
'(snip) ici le code de remplacement
End With

If Dir(nouveau_nom) <> "" Then
rep = InputBox(nouveau_nom & " existe dejà." & vbCrLf & "Effacer ->
Tapez 'OK', puis cliquez sur le bouton OK" & vbCrLf & "Sinon, pressez le
bouton 'Annuler'", "Remplacer le fichier ??", "??")
If UCase(rep) = "OK" Then
Application.DisplayAlerts = False
Kill nouveau_nom
Application.DisplayAlerts = True
ActiveDocument.SaveAs Filename:=nouveau_nom
End If
Else
ActiveDocument.SaveAs Filename:=nouveau_nom
End If
.Quit
End With

Set MonDoc = Nothing
End Sub





Avatar
FxM
Re-,

Le verdict vient de tomber ...
ça marche également sur l'autre poste !

Denis, je ne te fais pas la bise mais le coeur y est :o)
Encore MERCI

FxM




Bonjour FxM,

As-tu essayé quelque chose comme ceci :
Évidemment, tu devrais la compléter ...


'--------------------------
Sub test()

Dim Wd As Object, Dc As Object

Set Wd = CreateObject("word.application")
With Wd
.Visible = True
Set Dc = .Documents.Add(Template:=lettre, NewTemplate:úlse)
'Traitement à effectuer avec le fichier Word
Traitement Dc
Dc.SaveAs "c:toto.doc"
Dc.Close
End With

Wd.Quit
End Sub
'-----------------------------------
Sub Traitement(Dc As Object)
With Dc
MsgBox .Name
End With
End Sub
'--------------------------



"FxM" a écrit dans le message de news:

Bonsoir,

Je vous soumets un problème lors de la sauvegarde d'un fichier Word
piloté depuis Excel.
Je développe sous Win2000 / Office 2002 et n'ai pas de souci avec le
code ci-dessous. Sur un autre poste WinXP / Office 2003, le fichier Word
reste ouvert au lieu de s'enregistrer et se refermer tout seul.
L'erreur indiquée est :
erreur d'exécution "4248"
Commande non disponible : aucun document n'est ouvert

La ligne suivante est en jaune :
ActiveDocument.SaveAs Filename:=nouveau_nom

Le remplacement de
ActiveDocument.SaveAs Filename:=nouveau_nom
par
Mondoc.SaveAs Filename:=nouveau_nom
donne une erreur 438 chez tous les deux.

Merci pour toute idée et @+
FxM




Voici le code un peu simplifié :
Sub test_lettre(b)
Dim tablo: ReDim tablo(0 To 7, 0 To 1)
Dim ligne As Long, facture As String, lettre As String, MonDoc As
Object, a As Integer
Dim nouveau_nom As String, rep As String

'(snip) ici le tableau de remplacement

nouveau_nom = ActiveWorkbook.Path & "" & Range("B" & ligne) &
"_Fact-" & Range("J" & ligne) & ".doc"

lettre = ThisWorkbook.Path & "CF 1 _ 2nd.dot"
Set MonDoc = CreateObject("Word.Application")
With MonDoc
.Documents.Add Template:=lettre, NewTemplate:úlse
.Visible = True

With .Selection.Find
'(snip) ici le code de remplacement
End With

If Dir(nouveau_nom) <> "" Then
rep = InputBox(nouveau_nom & " existe dejà." & vbCrLf & "Effacer ->
Tapez 'OK', puis cliquez sur le bouton OK" & vbCrLf & "Sinon, pressez le
bouton 'Annuler'", "Remplacer le fichier ??", "??")
If UCase(rep) = "OK" Then
Application.DisplayAlerts = False
Kill nouveau_nom
Application.DisplayAlerts = True
ActiveDocument.SaveAs Filename:=nouveau_nom
End If
Else
ActiveDocument.SaveAs Filename:=nouveau_nom
End If
.Quit
End With

Set MonDoc = Nothing
End Sub





Avatar
MichDenis
Merci de ce retour FxM.


"FxM" a écrit dans le message de news:

Re-,

Le verdict vient de tomber ...
ça marche également sur l'autre poste !

Denis, je ne te fais pas la bise mais le coeur y est :o)
Encore MERCI

FxM




Bonjour FxM,

As-tu essayé quelque chose comme ceci :
Évidemment, tu devrais la compléter ...


'--------------------------
Sub test()

Dim Wd As Object, Dc As Object

Set Wd = CreateObject("word.application")
With Wd
.Visible = True
Set Dc = .Documents.Add(Template:=lettre, NewTemplate:úlse)
'Traitement à effectuer avec le fichier Word
Traitement Dc
Dc.SaveAs "c:toto.doc"
Dc.Close
End With

Wd.Quit
End Sub
'-----------------------------------
Sub Traitement(Dc As Object)
With Dc
MsgBox .Name
End With
End Sub
'--------------------------



"FxM" a écrit dans le message de news:

Bonsoir,

Je vous soumets un problème lors de la sauvegarde d'un fichier Word
piloté depuis Excel.
Je développe sous Win2000 / Office 2002 et n'ai pas de souci avec le
code ci-dessous. Sur un autre poste WinXP / Office 2003, le fichier Word
reste ouvert au lieu de s'enregistrer et se refermer tout seul.
L'erreur indiquée est :
erreur d'exécution "4248"
Commande non disponible : aucun document n'est ouvert

La ligne suivante est en jaune :
ActiveDocument.SaveAs Filename:=nouveau_nom

Le remplacement de
ActiveDocument.SaveAs Filename:=nouveau_nom
par
Mondoc.SaveAs Filename:=nouveau_nom
donne une erreur 438 chez tous les deux.

Merci pour toute idée et @+
FxM




Voici le code un peu simplifié :
Sub test_lettre(b)
Dim tablo: ReDim tablo(0 To 7, 0 To 1)
Dim ligne As Long, facture As String, lettre As String, MonDoc As
Object, a As Integer
Dim nouveau_nom As String, rep As String

'(snip) ici le tableau de remplacement

nouveau_nom = ActiveWorkbook.Path & "" & Range("B" & ligne) &
"_Fact-" & Range("J" & ligne) & ".doc"

lettre = ThisWorkbook.Path & "CF 1 _ 2nd.dot"
Set MonDoc = CreateObject("Word.Application")
With MonDoc
.Documents.Add Template:=lettre, NewTemplate:úlse
.Visible = True

With .Selection.Find
'(snip) ici le code de remplacement
End With

If Dir(nouveau_nom) <> "" Then
rep = InputBox(nouveau_nom & " existe dejà." & vbCrLf & "Effacer ->
Tapez 'OK', puis cliquez sur le bouton OK" & vbCrLf & "Sinon, pressez le
bouton 'Annuler'", "Remplacer le fichier ??", "??")
If UCase(rep) = "OK" Then
Application.DisplayAlerts = False
Kill nouveau_nom
Application.DisplayAlerts = True
ActiveDocument.SaveAs Filename:=nouveau_nom
End If
Else
ActiveDocument.SaveAs Filename:=nouveau_nom
End If
.Quit
End With

Set MonDoc = Nothing
End Sub