Excel word Publipostage

[skyof]

Bonjour,

Je suis en train de créer un fichier excel qui me permet non seulement de créer une BDD pour mon personnel mais aussi de tenter de créer le contrat de travail adéquat (5 contrats différents) à partir de la BDD. Ainsi, je suis arrivé à automatiser ma BDD mais je n'arrive pas à créer une macro me permettant d'ouvrir un fichier Word, choisir le bon contrat, récupérer les éléments du contrat et les inscrire en publipostage.

Une aide potentielle sur le forum ?

Merci

 

[Brigitte]

Re : Excel word Publipostage

Bonjour,

Je pense que j'ai un fichier qui fait, à peu de choses près, ce dont tu rêves.

Un fichier excel (tableau) que l'on remplit...
J'ai prévu un champ "étiquettes" (à adapter si besoin) où je mets une croix si je veux la fusion
Une barre d'outils dans ce fichier avec : créer les étiquettes (dans mon cas)
Quand le tableau est rempli, et que l'on clique sur ce bouton :

- Ca ouvre une boîte de dialogue (explorateur)
- On choisit le fichier word adapté (dans lequel on aura pris soin de mettre les champs)
- La fusion se fait toute seule...

Si oui, voici le code de mon fichier (à mettre dans un MODULE standard) :

Sub Publipostage()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Chemin = ActiveWorkbook.Path
    ' ***** INFOS IMPORTANTES ***************************************************
    ' Export des données dans un classeur temporaire pour éviter d'avoir
    ' une instance Excel qui reste dans la Liste des Tâches
    ' C'est ce document temporaire qui sera utilisé par Word lors de la fusion et
    ' évitera les inconvénients cités plus haut.
    ' ---------------------------------------------------------------------------
    Sheets(Array("Bord versement AI", "Listes")).Select
    Sheets(Array("Bord versement AI", "Listes")).Copy
    ActiveWorkbook.SaveAs Chemin & "\Temp.xls"
    ActiveWorkbook.Close savechanges:=False
    ' ***************************************************************************
    'Vérifier si il y a des croix présentes pour procéder au mailing
    Sheets("Bord versement AI").Activate
    Range([C2], [F65536].End(xlUp).Offset(0, -3)).Select
    NbreX = Application.CountIf(Selection, "x")
    If NbreX = 0 Then
        MsgBox "Il n'y a pas d'étiquette à extraire.", vbInformation + vbOKOnly
        Range("A1").Select
        Exit Sub
    End If
    ' Recherche du document Word servant au Publipostage
    '   ChDrive "C:\"
    ChDir ActiveWorkbook.Path
    FileMailing = Application.GetOpenFilename("Fichiers Word (*.doc), *.doc", , "Ouvrir le document Word pour le mailing d'étiquettes ...")
    If FileMailing = "Faux" Then End
    ' Ouverture de Word
    Dim AppWord As Word.Application
    Set AppWord = New Word.Application
    Application.ScreenUpdating = False
    AppWord.Visible = False    'True
    Set DocWord = AppWord.Documents.Open(FileMailing)
    NomBase = Chemin & "\Temp.xls"
    ' Ouverture de la base de données, passage des paramètres
    ' pour la requête et lancement du Publipostage
    With DocWord.MailMerge
        .OpenDataSource Name:=NomBase, _
                        Connection:="Driver={Microsoft Excel Driver (*.xls)};" & "DBQ=" & _
                                    NomBase & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [Bord versement AI$] WHERE [ETIQUETTE] like 'x' OR [ETIQUETTE] like 'X'"
        'Spécifie la fusion vers un nouveau document (wdSendToPrinter= Vers l'imprimante)
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        'Prend en compte l'ensemble des enregistrements
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
    ' Activation du doucment principal de Publipostage et fermeture
    DocWord.Activate
    DocWord.Close savechanges:=False
    ' Affichage l'application Word
    AppWord.Visible = True
    Set DocWord = Nothing
    Set AppWord = Nothing
    ' Activation de l'onglet
    Sheets("Bord versement AI").Select
    ' Effacement du fichier temporaire crée spécialement pour la fusion
    Kill Chemin & "\temp.xls"
End Sub

Quant à la barre d'outils :

Public CalcTaskID
Public Const MyCommandBarName As String = "SDIS 44 - © 2009"
Private Sub DeleteMyCommandBar()
' Efface la barre d'outils MyCommandBarName
    On Error Resume Next
    Application.CommandBars(MyCommandBarName).Delete
    On Error GoTo 0
End Sub
Sub CreateMyCommandBar()
' Création de la barre d'outils personnalisée MyCommandBarName
    Dim CB As CommandBar, cc As CommandBarButton
    Application.ScreenUpdating = False
    DeleteMyCommandBar    ' au cas où celle-ci existe déjà
    Set CB = Application.CommandBars.Add(MyCommandBarName, msoBarFloating, False, True)
    AddMenuToCommandBarFormats CB, True
End Sub
Private Sub AddMenuToCommandBarFormats(CB As CommandBar, blnBeginGroup As Boolean)
' adds a menu to a commandbar, duplicate this procedure for each menu you want to create
    Dim m As CommandBarPopup, mi As CommandBarButton
    If CB Is Nothing Then Exit Sub
    With CB
        Set cc = CB.Controls.Add(msoControlButton, , , , True)
        With cc
            .BeginGroup = True
            .OnAction = "brigitte"
            .Caption = "Ajouter des lignes"
            .TooltipText = "Permet d'ajouter des lignes."
            .Style = msoButtonIconAndCaption
            .FaceId = 296
        End With
        ' Création menu
        Set cc = CB.Controls.Add(msoControlButton, , , , True)
        With cc
            .BeginGroup = blnBeginGroup
            .Caption = "Créer les étiquettes"
            .OnAction = "Publipostage"
            .TooltipText = "Permet de créer des étiquettes pour archives."
            .FaceId = 590
            .Style = msoButtonIconAndCaption
        End With
       Set cc = CB.Controls.Add(msoControlButton, , , , True)
        With cc
            .BeginGroup = blnBeginGroup
            .OnAction = "StartCalculator"
            .TooltipText = "Permet d'effectuer des opérations mathématiques."
            .FaceId = 283
            .Style = msoButtonIcon
        End With
        .Visible = True
        .Left = 650  ' the left position of the commandbar
        .Top = 210    ' the right position of the commandbar
    End With
    Set cc = Nothing
    Set CB = Nothing
    Set cx = Nothing
End Sub
Sub StartCalculator()
    Dim AppFile As String
    AppFile = "Calc.exe"
    On Error Resume Next
    AppActivate "Calculatrice"
    If Err <> 0 Then
        Err = 0
        CalcTaskID = Shell(AppFile, 1)
        If Err <> 0 Then MsgBox "Impossible de lancer la calculatrice"
    End If
End Sub

Dans le dernier code, tu as en prime la calculatrice...

Tout ce code m'a été offert par Renauder, un éminent xldien... que je remercie encore ici.

 

[fhoest]

Re : Excel word Publipostage

bonjour ,
voici comment j'ouvre un document word dans une de mes applications
il suffit juste de l'adapter et de dimmensionner quelques variables que j'ai placer en pubic sous un option explicit
voici le code:
Private Sub CommandButton1_Click()

Dim strFichier As String
Dim objWord As New Word.Application
strFichier = chemin
' ouvrir un document Word
objWord.Documents.Open strFichier
' rendre Word visible
objWord.Visible = True

' ton code

' fermer le document
'objWord.Documents(1).Close
' quitter l'application Word
'objWord.Quit

' libérer la mémoire
Set objWord = Nothing
ActiveWorkbook.Close
End Sub
A bientot