Boite de dial. "Saveas" WORD préremplie depuis Excel

Bonjour à tous ,

cherchant sans succès à combiner différentes méthodes trouvé sur le net, je sèche complétement.

J'ai écris une macro qui ouvre un document Word et colle un tableau Excel dedans.

Je souhaite ensuite pouvoir:

  • Ouvrir une boite de dialogue "Save as" dans Word
  • Appliquer un nom prédéfini (égal à une cellule dans Excel)
  • Appliquer un répertoire prédéfini
  • Enregistrer sous un document .doc
  • Et surtout que l'utilisateur se retrouve à travailler sur le document enregistré-sous et non sur l'ancien.

Je me suis rapproché de la solution grâce à ce code, mais le document actif demeure l'ancien et le chemin d'accès plonge par défaut dans les dossier de Microsoft:

'Boite de dialogue pour enregistrer le document automatiquement avec le nom
If Cells(ActiveCell.Row - 1, 2).Value = "CSLT" Then
wordapp.FileDialog(msoFileDialogSaveAs).InitialFileName = Cells(ActiveCell.Row - 1, 5).Value & " " & Cells(ActiveCell.Row - 1, 6).Value & " " & "PSY-CONF"
Dim choice As Integer
choice = wordapp.FileDialog(msoFileDialogSaveAs).Show
    If choice <> 0 Then
        Filename = wordapp.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
        Call ActiveDocument.SaveAs(Filename:=Filename, FileFormat:=wdFormatDocumentDefault)

En vous remerciant pour les pistes que vous trouverez.

Merci pour vos lumières!!!

Sub ouvrirdoc()

'Attribution de variables
Dim chemin As String
Dim test As String

'Attribution d'une valeur de base aux variables
chemin = Sheets("En tête compte rendu").Range("i1")

'Test presence document Compte rendu vierge"
If Sheets("En tête compte rendu").Range("i1") = "" Or Sheets("En tête compte rendu").Range("i1") = Faux Or Dir(chemin) = "" Then
MsgBox "Veuillez assigner un modèle de compte rendu Word.", vbInformation
ThisWorkbook.Sheets("En tête compte rendu").Range("i1") = Application.GetOpenFilename(, , "Veuillez choisir le fichier vierge pour compte rendu")
If ThisWorkbook.Sheets("En tête compte rendu").Range("i1") = False Then
Exit Sub
End If
End If

'Désactivation rafraichissement d'écran
screenupdate = False

'Attribution de la nouvelle valeure aux variables
chemin = Sheets("En tête compte rendu").Range("i1")

'CopierCompteRendu et retour sur onglet Récapitulatif
Sheets("En tête compte rendu").Range("A1:C21").Copy

'Ouverture du fichier word
Set wordapp = CreateObject("word.Application")
wordapp.Visible = True
wordapp.Documents.Open chemin
wordapp.ActiveWindow.ActivePane.VerticalPercentScrolled = 1

'Sélection de l'application, de tout le contenu, et collage du contenu Excel
With wordapp.Selection
.WholeStory
.Select
.Paste
End With

'Word apparait au premier plan et le document est présenté à partir du haut de page
With wordapp
.Activate
.ActiveWindow.ActivePane.VerticalPercentScrolled = 1
Sheets("Récapitulatif").Activate

End With
End Sub
  
Rechercher des sujets similaires à "boite dial saveas word preremplie"