1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
| Dim DocWord As Word.Document
Dim Chemin, lettre_col_offre, lettre_col_qté, lettre_col_art, lettre_col_fin As String
Dim qté, ligne, i_ligne, col_offre, col_qté, i_fin As Integer
'Récupération indice ligne du tableau + colonne quantité + colonne offre
i_ligne = Application.Match("Elément", Worksheets(nom).Columns(1), 0)
i_fin = Application.Match("fin", Worksheets(nom).Columns(1), 0)
col_qté = Application.Match("Qté", Worksheets(nom).Rows(i_ligne & ":" & i_ligne), 0)
col_offre = Application.Match("Désignation paragraphe offre", Worksheets(nom).Rows(i_ligne & ":" & i_ligne), 0)
'Récupération des indices en "lettre" des colonnes qté et offre (ex indice "lettre" : "A")
lettre_col_art = Split(Worksheets(nom).Columns(col_offre + 5).Address(ColumnAbsolute:=False), ":")(1)
lettre_col_offre = Split(Worksheets(nom).Columns(col_offre + 6).Address(ColumnAbsolute:=False), ":")(1)
lettre_col_qté = Split(Worksheets(nom).Columns(col_offre + 7).Address(ColumnAbsolute:=False), ":")(1)
Chemin = Environ("USERPROFILE") & "\Mes documents\Offre2017"
'Ouvre le document Word
Set DocWord = GetObject(Chemin & "\test.docx")
DocWord.Application.Visible = True
'Copie les données dans excel
Worksheets(nom).Range(lettre_col_offre & i_ligne & ":" & lettre_col_qté & i_fin).Copy
'Colle la désignation offre dans Word
DocWord.Range(Start:=0, End:=1).PasteSpecial
Application.CutCopyMode = False |
Partager