Aide en vba pour excel vers word

David -
GilRoB - 2 avril 2008 à 19:59

Bonjour à tous,

Je souhaite créer depuis une macro dans excel, un tableau dans word à partir de certaines cellules d'un tableau excel.(créer une facture)
J'ai écris la macro, la copie des cellules souhaiter dans word sans problème.
Je ne sais pas comment appliquer une mise en forme à certaine cellules uniquement dans word(Encadrer : le tableau, la première ligne et les deux cellules de droite en fin de tableau.Et comment verifier que dans word le tableau ne comporte aucune ligne vide et sinon les supprimées.
Voir code, je débute en vba, c'est ma première macro !!!.

Merci d'avance
David

Option Explicit
Private Sub btnOuvreDocWord_Click()

'""""""""""""""""""""""""" Déclaration des variables""""""""""""""""""""""""""""""""""
Dim AppWord As Word.Application
Dim DocWord As Word.Document

Dim vAffaire As Object
Dim vRéférences As Object
Dim vCellule_Word As Object

Dim vDerligne_1 As Integer
Dim vDerligne_2 As Integer
Dim vDerligne_3 As Integer
Dim vDerligne_4 As Integer
Dim Cmptr, Nbre_Lignes_Fact, z, i As Integer
Dim colonne_AFFAIRE As String
Dim colonne_Références As Variant
Dim colonne_Prix As Variant
Dim Total_2ème_tableau As Variant
Dim Total_1er_tableau As Variant
'-----------------------------creation session Word-----------------------------------
Set AppWord = New Word.Application
    
    
Application.DisplayAlerts = True
AppWord.ShowMe

'pour que word reste masqué pendant l'opération
AppWord.Visible = True

 'Appel le document Word
Set DocWord = AppWord.Documents.Open("E:\CD SECRETARIAT\temps_david\teste FACT TYPE.doc", _
              ReadOnly:=False)
        
'#####################################################################################
'############################# Création de la première page ##########################
'#####################################################################################

'------------------Copie les données Excel de la colonne AFFAIRE----------------------
'-----------------  Prend les valeurs des cellules C3 à C30    ----------------------
                    

'Boucle pour lecture des lignes 3 à 29 dans colonne C
For Each vAffaire In [C3:C29]

    'Teste si cellule n'est pas vide
    If vAffaire <> "" Then

         colonne_AFFAIRE = vAffaire.Value

'____________________________________________________________________________________

'-----------------------------Colle les données dans Word'--------------------------
         'Ajoute les lignes l'une sous l'autre
         DocWord.Tables(1).Rows.Add

         'Variable recevant le Numéro de la dernière ligne
         vDerligne_1 = DocWord.Tables(1).Rows.Count

            With DocWord.Tables(1)
                vDerligne_1 = vDerligne_1 - 28
                .Cell(vDerligne_1, 1).Range.InsertAfter colonne_AFFAIRE
            End With

    Else
    'Sort de la boucle si cellule vide
        Exit For

      End If

Next
'____________________________________________________________________________________

'Passage de valeur
vDerligne_2 = vDerligne_1

'----------------Copie les données Excel de la colonne REFERENCES'------------------
'----------------    Prend les valeurs des cellules D3 à D30      ------------------

'Boucle pour ecrire sur ligne 1 de référence
For Cmptr = 3 To vDerligne_2

    'Boucle pour lecture des lignes 3 à 29 dans colonne D
    For Each vRéférences In [D3:D29]

        'Teste si cellule n'est pas vide
        If vRéférences <> "" Then

            'ECRIRE LA COLONNE REFERENCE
            colonne_Références = vRéférences.Value
            'ECRIRE LA COLONNE PRIX
            colonne_Prix = ActiveSheet.Range("B1").Value & " €"
'____________________________________________________________________________________

'-----------------------------Colle les données dans Word'--------------------------

            With DocWord.Tables(1)

                vDerligne_2 = (vDerligne_2 + Cmptr) - vDerligne_2
                .Cell(vDerligne_2 - 1, 2).Range.InsertAfter colonne_Références
                .Cell(vDerligne_2 - 1, 3).Range.InsertAfter colonne_Prix
                'Incremente le compteur de ligne de la boucle
                Cmptr = Cmptr + 1

            End With

        Else
        'Sort de la boucle si cellule vide
            Exit For

        End If

    Next
 '____________________________________________________________________________________

'-----------------Colle les données dans Word pour le "SOUS TOTAL"------------------
            With DocWord.Tables(1)

                Nbre_Lignes_Fact = vDerligne_2 - 2
                colonne_Références = "SOUS TOTAL"
                colonne_Prix = (ActiveSheet.Range("B1").Value * Nbre_Lignes_Fact) & " €"
                Total_1er_tableau = colonne_Prix
                vDerligne_2 = vDerligne_2 '+ 1
                .Cell(vDerligne_2, 2).Range.InsertAfter colonne_Références
                .Cell(vDerligne_2, 3).Range.InsertAfter colonne_Prix

            End With
Next

'____________________________________________________________________________________


'#####################################################################################
'############################# Création de la deuxieme page ##########################
'#####################################################################################

'----------------------Copie les données Excel de la colonne AFFAIRE------------------
'----------------------  Prend les valeurs des cellules C31 à C70   ------------------

'Boucle pour lecture des lignes 30 à 70 dans colonne C
For Each vAffaire In [C30:C70]

    'Teste si cellule n'est pas vide
    If vAffaire <> "" Then

         colonne_AFFAIRE = vAffaire.Value
         ' Colle les données dans Word
         DocWord.Tables(3).Rows.Add
         vDerligne_3 = DocWord.Tables(3).Rows.Count

            With DocWord.Tables(3)

                  .Cell(vDerligne_3, 1).Range.InsertAfter colonne_AFFAIRE

            End With

    Else
    'Sort de la boucle FOR si cellule vide
        Exit For

      End If

Next
'____________________________________________________________________________________

vDerligne_4 = vDerligne_3 + 1

'---------------------Copie les données Excel de la colonne REFERENCES---------------
'---------------------    Prend les valeurs des cellules D35 à D70    ---------------

'Boucle pour ecrire sur ligne suivante de référence
For Cmptr = 3 To vDerligne_4

    'Boucle pour lecture des lignes 30 à 70 dans colonne D
    For Each vRéférences In [D30:D70]

        'Teste si cellule n'est pas vide
        If vRéférences <> "" Then

            'ECRIRE LA COLONNE REFERENCE
            colonne_Références = vRéférences.Value
            'ECRIRE LA COLONNE PRIX
            colonne_Prix = ActiveSheet.Range("B1").Value & " €"
         ' Colle les données dans Word

         ' Colle les données dans Word
            With DocWord.Tables(3)

                'Commençer à Ecrire sur la 2ème ligne du tableau de la 2ème page
                ' et sur les lignes suivantes pour les colonnes Référence et Prix
                vDerligne_4 = (vDerligne_4 + Cmptr) - vDerligne_4
                .Cell(vDerligne_4, 2).Range.InsertAfter colonne_Références
                .Cell(vDerligne_4, 3).Range.InsertAfter colonne_Prix

                'Incremente le compteur de ligne de la boucle
                Cmptr = Cmptr + 1

            End With

        Else
            'Sort de la boucle FOR si cellule vide
            Exit For

        End If

    Next
        'Teste si au moin une ligne écrite dans tableau page 2
        If vDerligne_3 > 1 Then

          ' Colle les données dans Word pour le "SOUS TOTAL"
            With DocWord.Tables(3)

                Nbre_Lignes_Fact = vDerligne_4 - 1
                colonne_Références = "SOUS TOTAL"
                'Formule pour le TOTAL DE LA FACTURE
                Total_2ème_tableau = (ActiveSheet.Range("B1").Value * Nbre_Lignes_Fact)
                colonne_Prix = Total_1er_tableau + Total_2ème_tableau & " €"
                vDerligne_4 = vDerligne_4 + 1
                .Cell(vDerligne_4, 2).Range.InsertAfter colonne_Références
                .Cell(vDerligne_4, 3).Range.InsertAfter colonne_Prix

                'Sort de la boucle FOR
                Exit For

            End With

        End If

Next

'____________________________________________________________________________________

'"""""""""""""Ecrit la mention obligatoire sur page 1 sinon sur page 2"""""""""""""""

   If vDerligne_3 > 1 Then
        'Supprime la première sous ligne titre du tableau de la page 1
        DocWord.Tables(3).Rows(2).Delete

        'Supprime les Mentions Obligatoire sur la page 1 sur le document TYPE
        DocWord.Tables(2).Rows(1).Delete

   Else
        'Supprime les Mentions Obligatoire sur la page 2 sur le document TYPE
        DocWord.Tables(4).Rows(1).Delete
        'Supprime la première ligne titre du tableau de la page 2-------------
        DocWord.Tables(3).Rows(2).Delete

   End If
'____________________________________________________________________________________

'Rend le document Word Visible
AppWord.Visible = True

'Imprime le document
'ActiveDocument.PrintOut
End Sub

Afficher la suite

A voir également:

Aide en vba pour excel vers word
Word et excel gratuit - Guide
Word 2013 - Télécharger - Traitement de texte
Tableau word - Guide
Liste déroulante excel - Guide
Espace insécable word - Guide

1 réponse

Réponse 1 / 1

GilRoB

bonjour,

je suis pas mal interessé par ton programme... pourrais indiquer le code que tu as écris pour copier/coller les données excel vers le doc word, STP.
Pour ton probleme, mon niveau en VB est encore bien torp bas, DSL

Votre réponse