Ouvrir une fenâtre parcourir depuis une macro VBA dans word

Signaler
Messages postés
12
Date d'inscription
jeudi 15 février 2007
Statut
Membre
Dernière intervention
4 décembre 2009
-
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
-
Bonjour,

Je travaille sur une macro intégrée à Word qui a pour but de faciliter le publipostage conditionnel de documents. La macro fonctionne mais n'est pas souple du tout. Je m?explique : le nom du fichier Excel qui sert de source au publipostage et le nom du fichier Word qui sert de modèle sont en dur dans le code.
Or ces fichiers changent de nom régulièrement car ils sont mis à jour et changeront aussi de place de dossier suivant les utilisateurs (chacun à sa propre arborescence).

Ce que je souhaiterais obtenir c'est une fenêtre Parcourir qui s'ouvrirait au lancement de la macro et qui permettrait à l'utilisateur de choisir le fichier source. Pour avoir ça j'ai essayé :
FichierSource = Application.GetOpenFilename("Fichier excel, *.xls", , , , True)

Mais ça ne fonctionne pas.
Et il faudrait aussi que je puisse récupérer le chemin et le nom du fichier Word modèle depuis lequel la macro sera lancée. Pour cela j'ai essayé :
FichierModele = ThisDocument.Path
Mais évidemment? ça ne marche pas !

Quelqu'un aurait-il une idée pour régler ces deux problèmes ? Merci d'avance !

Ci-dessous la partie de la macro qui pose problème :

'Déclaration des variables
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlSh As Excel.Worksheet
Dim LettreModele as Document

'Affectation des données aux variables
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open("C:\Documents and Settings\...\Nom_fichier.xls") 'Fichier source
Set xlSh = xlWb.Worksheets(1)
Set LettreModele = Documents.Add("C:\Documents and Settings\...\Nom_fichier.doc")



Ce n'est pas parce qu'ils sont nombreux à avoir tort qu'ils ont raison !

11 réponses

Messages postés
1207
Date d'inscription
dimanche 20 avril 2003
Statut
Membre
Dernière intervention
4 juin 2016
9
Bonjour,

Qu'appelles-tu ne pas marcher ? As-tu on message d'erreur. Sinon il y a aussi la fonction API GetOpenFilename().

Calade
Messages postés
12
Date d'inscription
jeudi 15 février 2007
Statut
Membre
Dernière intervention
4 décembre 2009

Bonjour,

Pour ce qui est de la fenêtre Parcourir, il y a un message d'erreur : Erreur de compilation : Membre de méthode ou de données introuvable

et pour le chemin du document actif Word ça me donne :
C:\Documents and Settings\Mon_ordi\Application Data\Microsoft\Modèles
alors qu'il se trouve là :
C:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier


Ce n'est pas parce qu'ils sont nombreux à avoir tort qu'ils ont raison !
Messages postés
1207
Date d'inscription
dimanche 20 avril 2003
Statut
Membre
Dernière intervention
4 juin 2016
9
Indique-nous ton code ainsi que les référenses à Office que tu as mises.


Calade
Messages postés
12
Date d'inscription
jeudi 15 février 2007
Statut
Membre
Dernière intervention
4 décembre 2009

Voici les références activées :
[list]
Visual basic For Applications
OLE Automation
Les librairies de : Word, Excel, Office et Common Language Runtime Execution Engine/list

et voici le code (Je ne suis pas développeuse donc ce n'est pas optimisé, merci de votre compréhension ):

Sub Macro1()

'Déclaration des variables
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlSh As Excel.Worksheet
Dim CheminFichier As String
Dim iR As Integer
Dim i As Integer
Dim j As Integer
Dim NomSalarie As String
Dim PrenomSalarie As String
Dim MatriculeCourant As Integer
Dim MatriculeSuivant As Integer
Dim DocName As String
Dim LettrePubli As Document

On Error GoTo GestErr

'Affectation des données aux variables
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open("C:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier\Fichier_source.xls") 'il faudrait qu'une fenêtre parcourir permette de choisir ce fichier
Set xlSh = xlWb.Worksheets(1)
Set LettrePubli = Documents.Add("C:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier\Modele_lettre.doc") 'il faudrait que je puisse trouver le chemin de ce fichier automatiquement (car sera à différents endroits selon les utilisateurs)
NomSalarie = ""
PrenomSalarie = ""
MatriculeCourant = 0
MatriculeSuivant = 0
DocName = ""

'Récupération du nombre de lignes du fichier xls :
iR = xlSh.UsedRange.Rows.Count

'Phase de récupération des données de la feuille pour les injecter dans le document :
For i = 2 To iR
    
    If MatriculeCourant = 0 Then
    
        'Enregistrement du matricule courant:
        MatriculeCourant = xlSh.Cells(i, 1)
        
        'On rempli les signets avec les infos nécessaire :
        'Enregistrement du nom du salarié :
        NomSalarie = xlSh.Cells(i, 2) 
        LettrePubli.Bookmarks("Nom").Range.Text = NomSalarie
        'Enregistrement du prénom du salarié :
        PrenomSalarie = xlSh.Cells(i, 3)
        'Enregistrement du prénom du salarié :
        PrenomSalarie = xlSh.Cells(i, 3)
        LettrePubli.Bookmarks("Prénom").Range.Text = PrenomSalarie
        LettrePubli.Bookmarks("N1").Range.Text = xlSh.Cells(i, 4)
        LettrePubli.Bookmarks("DIF").Range.Text = xlSh.Cells(i, 6)
        LettrePubli.Bookmarks("IntituléFormation").Range.Text = xlSh.Cells(i, 18)
        
        'On crée un nom de fichier à son nom :
        DocName = NomSalarie & "-" & PrenomSalarie & "-" & MatriculeCourant & "-" & Format(Date, "yyyy")
        
    'Si le salarié actuel est différent du suivant :
    ElseIf MatriculeCourant <> MatriculeSuivant Then
               
        'Enregistrement du fichier du salarié actuel :
        With LettrePubli
            .SaveAs "c:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier\Publipostage" & DocName & ".doc"
            '.MailMerge.Destination = wdSendToPrinter
            .Close
        End With
        
        'Création d'un fichier vierge:
        Set LettrePubli = Documents.Add("C:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier\Modele_lettre.doc")
        
        MatriculeCourant = MatriculeSuivant

        'On rempli les signets avec les infos nécessaire :
        'Enregistrement du nom du salarié :
        NomSalarie = xlSh.Cells(i, 2) 'le nb 2 correspond à la colonne 2 du fichier xls
        LettrePubli.Bookmarks("Nom").Range.Text = NomSalarie
        'Enregistrement du prénom du salarié :
        PrenomSalarie = xlSh.Cells(i, 3)
        'Enregistrement du prénom du salarié :
        PrenomSalarie = xlSh.Cells(i, 3)
        LettrePubli.Bookmarks("Prénom").Range.Text = PrenomSalarie
        LettrePubli.Bookmarks("N1").Range.Text = xlSh.Cells(i, 4)
        LettrePubli.Bookmarks("DIF").Range.Text = xlSh.Cells(i, 6)
        LettrePubli.Bookmarks("IntituléFormation").Range.Text = xlSh.Cells(i, 18)
        
        'On crée un nom de fichier à son nom :
        DocName = NomSalarie & "-" & PrenomSalarie & "-" & MatriculeCourant & "-" & Format(Date, "yyyy")
                
        'Sinon si les matricules sont identiques on rajoute la formation à la liste existante dans la même lettre :
        Else
            LettrePubli.Bookmarks("IntituléFormation").Range.Text = xlSh.Cells(i, 18) + Chr(13)
        End If
        
        MatriculeSuivant = xlSh.Cells(i + 1, 1)
        
Next i

'On crée un nom de fichier à son nom :
DocName = NomSalarie & "-" & PrenomSalarie & "-" & MatriculeCourant & "-" & Format(Date, "yyyy")

'On enregistre et ferme la dernière lettre publipostée :
With LettrePubli
    .SaveAs "c:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier\Publipostage" & DocName & ".doc"
    .Close
End With

'Impression de la lettre publipostée :
'ActiveDocument.MailMerge.Destination = wdSendToPrinter

Set LettrePubli = Nothing

GestErr:
'Si pas de document ouvert on fait un resume next
If Err.Number = 91 Then Resume Next
Debug.Print "Erreur : " & Err.Number & Err.Description

xlWb.Close
xlApp.Quit
Set xlSh = Nothing
Set xlWb = Nothing
Set xlApp = Nothing

MsgBox ("Publipostage terminé !")

End Sub


Ce n'est pas parce qu'ils sont nombreux à avoir tort qu'ils ont raison !
Messages postés
1207
Date d'inscription
dimanche 20 avril 2003
Statut
Membre
Dernière intervention
4 juin 2016
9
C'est très bien, mais tu ne montres pas le code avec tes essais de GetOpenFileName() et tu ne précises pas où se situe l'erreur de compilation.


Calade
Messages postés
12
Date d'inscription
jeudi 15 février 2007
Statut
Membre
Dernière intervention
4 décembre 2009

Le problème se situe au niveau de l'affectation des variables :
J'avais essayé avec ce code pour l'affectation des variables :

CheminFichier = Application.GetOpenFilename("Fichier excel, *.xls", , , , True) 'Génère un message d'erreur : Erreur de compilation...
Set xlWb = CheminFichier
Set xlSh = xlWb.Worksheets(1)
ModeleLettre = ThisDocument.path 'ne donne pas le "vrai" chemin du doc
Set LettrePubli = Documents.Add(ModeleLettre)


Le problème se situerait-il au niveau du type de mes variables ?




Ce n'est pas parce qu'ils sont nombreux à avoir tort qu'ils ont raison !
Messages postés
1207
Date d'inscription
dimanche 20 avril 2003
Statut
Membre
Dernière intervention
4 juin 2016
9
Je n'ai pas essayé d'aller plus loin, la ligne
CheminFichier = Application.GetOpenFilename("Fichier excel, *.xls", , , , True) renvoie un tableau si le dernier paramètre est à True (MultiSelect) et tu le mets dans in string.

Passe MultiSelect à False, tu auras le bon chemin dans CheminFichier.


Calade
Messages postés
12
Date d'inscription
jeudi 15 février 2007
Statut
Membre
Dernière intervention
4 décembre 2009

Ca ne marche toujours pas, j'ai toujours le même message d'erreur (Erreur de compilation : Membre de méthode ou de données introuvable).

Merci quand même d'avoir réfléchi à mon problème



Ce n'est pas parce qu'ils sont nombreux à avoir tort qu'ils ont raison !
Messages postés
1207
Date d'inscription
dimanche 20 avril 2003
Statut
Membre
Dernière intervention
4 juin 2016
9
Essaye en ajoutant

Set xlApp = CreateObject("Excel.Application")
avant ton .GetOpenFileName


Calade
j'ai un probléme au niveau de mon code: erreur de compilation Membre de methode ou de données introuvable.
voici le code:
Option Compare Database
Option Explicit

Public Function DetectionAnomalieChampBoolean(param_1 As Integer, param_2 As Integer) As Boolean

Dim TesterLesChamps As New ChampsTables

'Le param_1 est égale à param_2 s'il y a une anomalie dans les champs des tables
If (TesterLesChamps.param_1 = TesterLesChamps.param_2) Then
DetectionAnomalieChampBoolean = False

Else
DetectionAnomalieChampBoolean = True

End If

Exit Function
End Function

Private Sub test_DetectionDesChamps()

Dim TesterLesChamps As ChampsTables
MsgBox TesterLesChamps.DetectionAnomalieChampBoolean(False)
MsgBox TesterLesChamps.DetectionAnomalieChampBoolean(True)

End Sub
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
232
Un amical BONJOUR à toi également (euh ... Non ===>> à rayer, alors)
Quel rapport vois-tu, toi, avec la discussion ouverte ?


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ