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
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
