Reproducing Excel table in Word

[Alex St-Pierre]

Hi,
Does anyone has already reproduce an excel table in word. I'm trying to do
that (the programmation is below) but it is very complex. I'm looking for
information to help me to progress.

What the program do is a mailmerge executed from Excel. The excel file
contains a sheet for mail merge data and others sheets (table1.1, table1.2,
etc.) for tables used in the mailmerge document. When I execute the macro in
excel, the Word Macro is executed and all the tables are formatted in word
just before the mailmerge execution.

The table formating seems to be very complex because:
1) Text with bold and exponents, italic, size caracter, ...
tbl.cell(i,j) = rngExcel.Cells(i, j).Format 'give format of the first
character and not of all character. Does anyone know how to paste all cell
formatting in word? I don't know if doing a copy and paste is the best
solution because, some cells are merged in excel and I have to adjust
formatting (borders,horizontal alignment) thereafter.
2) In excel table, some cell contains text that go on the following cells. I
have to merge the table cells in Word to take this into account. Also, it is
possible that the cells are merge in excel.
3) Want to respect column width, borders, alignment etc.
4) I added a section to take NumberFormat from Excel.
etc.

Does anyone have already done something similar to this ?
Is there a simpler way to have great word table formatting without having to
program each things? example: copy paste the table using a pre-determined
table formating. After that, adjust borders, column width, some alignments, ..

Thanks a lot !

Alex

Sub Merge_Word()
Dim appWord As Word.Application
Dim docWord1 As Word.Document
Dim docWord2 As Word.Document
Dim appExcel As Excel.Application
Dim wbExcel As Excel.Workbook

Dim tbl As Word.Table
Dim oRow As Row
Dim rngExcel As Excel.Range
Dim pathExcel, strFormat, strBookMark As String
Dim iCol As Integer

Set appWord = Word.Application
Set docWord1 = appWord.ActiveDocument

On Error Resume Next
Set appExcel = GetObject(, "Excel.Application")
If appExcel Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
End If
On Error GoTo 0

pathExcel = appExcel.ActiveWorkbook.Path & "\" &
appExcel.ActiveWorkbook.Name
' PathExcel = ActiveDocument.MailMerge.DataSource.Name
fileExcel = LCase(Right(pathExcel, Len(pathExcel) - InStrRev(pathExcel,
"\")))


On Error Resume Next
Set wbExcel = appExcel.Workbooks(fileExcel)
If wbExcel Is Nothing Then
Set wbExcel = appExcel.Workbooks.Open(FileName:=pathExcel,
UpdateLinks:=True, ReadOnly:=True)
' Set wbExcel = GetObject(PathExcel, "Excel.Workbook")
End If
On Error GoTo 0

For nbTab = 1 To 3

If nbTab = 1 Then
Set rngExcel = wbExcel.Application.sheets("table1.1").Range("table1_1")
Set rng = docWord1.Bookmarks("Table1_1").Range
ElseIf nbTab = 2 Then
Set rngExcel = wbExcel.Application.sheets("table1.2").Range("table1_2")
Set rng = docWord1.Bookmarks("Table1_2").Range
ElseIf nbTab = 3 Then
Set rngExcel = wbExcel.Application.sheets("table1.3").Range("table1_3")
Set rng = docWord1.Bookmarks("Table1_3").Range
End If

Set tbl = rng.Tables(1)

'1- Adjust number of rows
DerLineExcel = rngExcel.Rows.Count
DerLineWord = tbl.Rows.Count
j = DerLineExcel - DerLineWord

For k = 1 To j
tbl.Rows.Add
Next k
For k = 1 To -j
tbl.Cell(5, 1).Select
Selection.SelectRow
Selection.Rows.Delete
Next k

'2- Adjust number of columns

'3- Adjust column width
With tbl.Rows
.LeftIndent = 0
End With

UsableWidth = 432
TableWidth = 0
For CellNo = 1 To rngExcel.Rows(1).Cells.Count
TableWidth = TableWidth + rngExcel.Columns(CellNo).ColumnWidth
Next CellNo

For j = 1 To tbl.Columns.Count
For i = 1 To tbl.Rows.Count
tbl.Cell(i, j).Width = UsableWidth * rngExcel.Columns(j).ColumnWidth
/ TableWidth
Next i
Next j

'4- MergeCells
For i = 1 To rngExcel.Rows.Count
j = 1
Do Until j >= rngExcel.Columns.Count
With rngExcel
If .Cells(i, j).MergeCells = True Then
iCol = .Cells(i, j).MergeArea.Columns.Count
tbl.Cell(i, j).Select
Selection.MoveRight Unit:=wdCharacter, Count:=iCol - 1, Extend:=wdExtend
Selection.Cells.Merge
j = j + iCol
Else
j = j + 1
End If
End With
Loop 'j
Next i

'5- Remove all borders
With tbl
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
End With

'6- Add borders
With tbl
For i = 1 To tbl.Rows.Count
For j = 1 To tbl.Columns.Count

With rngExcel.Cells(i, j)
With .Borders(xlEdgeTop)
If .LineStyle = xlContinuous Then
C = wdLineStyleSingle
tbl.Cell(i, j).Borders(wdBorderTop).LineStyle =
wdLineStyleSingle
If .Weight = xlThin Then
tbl.Cell(i, j).Borders(wdBorderTop).LineWidth =
wdLineWidth025pt
ElseIf .Weight = xlMedium Then
tbl.Cell(i, j).Borders(wdBorderTop).LineWidth =
wdLineWidth150pt
Else
'MsgBox ("non defined excel border")
End If
Else
tbl.Cell(i, j).Borders(wdBorderTop).LineStyle =
wdLineStyleNone
End If
End With
With .Borders(xlEdgeBottom)
If .LineStyle = xlContinuous Then
tbl.Cell(i, j).Borders(wdBorderBottom).LineStyle =
wdLineStyleSingle
If .Weight = xlThin Then
tbl.Cell(i, j).Borders(wdBorderBottom).LineWidth =
wdLineWidth025pt
ElseIf .Weight = xlMedium Then
tbl.Cell(i, j).Borders(wdBorderBottom).LineWidth =
wdLineWidth150pt
Else
'MsgBox ("non defined excel border")
End If
Else
tbl.Cell(i, j).Borders(wdBorderBottom).LineStyle =
wdLineStyleNone
End If
End With
With .Borders(xlEdgeLeft)
If .LineStyle = xlContinuous Then
tbl.Cell(i, j).Borders(wdBorderLeft).LineStyle =
wdLineStyleSingle
If .Weight = xlThin Then
tbl.Cell(i, j).Borders(wdBorderLeft).LineWidth =
wdLineWidth025pt
ElseIf .Weight = xlMedium Then
tbl.Cell(i, j).Borders(wdBorderLeft).LineWidth =
wdLineWidth150pt
Else
'MsgBox ("non defined excel border")
End If
Else
tbl.Cell(i, j).Borders(wdBorderLeft).LineStyle =
wdLineStyleNone
End If
End With
With .Borders(xlEdgeRight)
If .LineStyle = xlContinuous Then
tbl.Cell(i, j).Borders(wdBorderRight).LineStyle =
wdLineStyleSingle
If .Weight = xlThin Then
tbl.Cell(i, j).Borders(wdBorderRight).LineWidth =
wdLineWidth025pt
ElseIf .Weight = xlMedium Then
tbl.Cell(i, j).Borders(wdBorderRight).LineWidth =
wdLineWidth150pt
Else
'MsgBox ("non defined excel border")
End If
Else
tbl.Cell(i, j).Borders(wdBorderRight).LineStyle =
wdLineStyleNone
End If
End With
End With

'With Selection.ParagraphFormat
' .LeftIndent = CentimetersToPoints(0)
' .SpaceBeforeAuto = False
' .SpaceAfterAuto = False
'End With

'7- Add data with formating
strData = rngExcel.Cells(i, j)
If IsNumeric(strData) And strData <> "" Then
strFormat = rngExcel.Cells(i, j).NumberFormat
If strFormat = "#,##0_);(#,##0)" Or strFormat = "# ##0_-;(#
##0)" Or strFormat = "#,##0_-;(#,##0)" Then ' voir ajout de n'importe quel _)
strFormat = "#,##0;(#,##0)"
End If
strData = Format(strData, strFormat)
If Right(strData, 1) = ")" Then
.Cell(i, j).Select
With Selection.ParagraphFormat
.RightIndent = CentimetersToPoints(-0.13)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
Else
.Cell(i, j).Select
With Selection.ParagraphFormat
.RightIndent = CentimetersToPoints(0)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
End If ')"
End If 'IsNumeric
.Cell(i, j).Range.text = strData
Next j
Next i
End With

Next nbTab

Exit Sub

'8- Add text to document
strBookMark = wbExcel.Path & "\bookmark1.doc"
Set docWord2 = appWord.Documents.Open(strBookMark, ReadOnly:=False)
docWord2.Bookmarks(1).Range.Select
Selection.Copy
docWord1.Bookmarks("Bookmark1").Range.Select
Selection.Paste
docWord2.Close

'9- Mailmerge execution
With docWord1.MailMerge

ActiveDocument.MailMerge.OpenDataSource Name:= _
pathExcel, ConfirmConversions:=False, ReadOnly:= _
True, LinkToSource:=True, AddToRecentFiles:=False,
PasswordDocument:="", _
PasswordTemplate:="", WritePasswordDocument:="",
WritePasswordTemplate:= _
"", Revert:=False, Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data
Source=C:\rap_modele_ameliorations.xls;Mode=Read;Extended
Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Engine " _
, SQLStatement:="SELECT * FROM `merge$`", SQLStatement1:="",
SubType:= _
wdMergeSubTypeAccess

.Destination = wdSendToNewDocument

With .DataSource
.FirstRecord = 1
.LastRecord = 1
End With
.Execute Pause:=False
End With
docWord1.Close (False)
' AppWord.Application.Quit

'10- Reset variables

Set appWord = Nothing
Set docWord1 = Nothing
Set appExcel = Nothing
Set wbExcel = Nothing
Set rngExcel = Nothing
Set rng = Nothing
Set tbl = Nothing
Set docWord2 = Nothing
End Sub

Sub Mailmerge_execution_from_excel()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim Chemin, Fichier, Chemin_Fichier, Source As String
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
Chemin_Fichier = Application.GetOpenFilename()
Source = ActiveWorkbook.Name
PathExcel = ActiveWorkbook.Path & "\" & Source

On Error Resume Next
Set WordApp = GetObject(, "Word.application")
If WordApp Is Nothing Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Fichier = LCase(Right(Chemin_Fichier, Len(Chemin_Fichier) -
InStrRev(Chemin_Fichier, "\")))
Set WordDoc = WordApp.Documents.Open(Filename:=Chemin_Fichier)
WordApp.Visible = True

WordApp.Documents(Fichier).Activate
WordApp.Run "merge_word"
With WdDoc
Name:=Source, _
LinkToSource:=True, _
Format:=wdOpenFormatAuto, _
SQLStatement:="SELECT * FROM `Données_Mailing$`"
End With

Set WordDoc = Nothing
Set WordApp = Nothing

End Sub

 

[Word Heretic]

G'day Alex St-Pierre <[email protected]>,

1) copy n paste explicit cells :-( Eg Excel.ActiveCell.Range.Copy

2)
a) Crikey mate, are you for real here? One way to achieve this would
be to paste the thing into our Word template, then use
range.information(woo hoo) to find our line changes and merge down
with following cells in the column until the vertical offsets between
the last char and the next row are less than that of the next unmerged
row. You could also go a step too far, notice its uselessness by the
lack of change of vertical offset to the next row, and then just undo
the last change.

b) Struth. Ask on the Excel groups whether you can detect the merged
state of the source cell. If so, you can possibly process it if it has
constraints.

3) From your VBE (Alt+F11), use the Object Explorer (F2) and look up
the Table object for its list of properties. Use word.mvps.org/FAQs if
you need VBA help.

4) Oh lucky you


However, there is a small ray of sunshine on this otherwise bleak
answer. You can easily and quickly format a table if you can live with
one of the default formats. You can adjust which parameters are
applied, so that gives you lots of table stylings to choose from. For
example, Table simple with no heading row or font treatments.

As for your code, dont have the time for a close look, commercially we
could work out something in a few weeks if needed, however

Set appWord = Nothing
Set docWord1 = Nothing

etc is way wrong, You need to observe the object hierarchy. Close
document elements before document objects before application objects
(as an example).

Steve Hudson - Word Heretic

steve from wordheretic.com (Email replies require payment)
Without prejudice


Alex St-Pierre reckoned:

 

[Shauna Kelly]

Hi Alex

Do the end-users of the merged documents have to edit the tables pasted from
Excel? If not, maybe you could paste them as a picture. You can use
something like this:

Sub GetExcelTable()

Dim xlApp As Excel.Application
Dim xlRange As Excel.Range
Dim wdRange As Word.Range

'Get a reference to Excel and to the
'range to paste into Word
Set xlApp = GetObject(, "Excel.Application")
Set xlRange = xlApp.Selection

'Get a reference to the place in the Word document
'to paste the table from Excel
Set wdRange = Word.Selection.Range
wdRange.Collapse wdCollapseStart

'Copy and paste the range selected in Excel
'into Word as a picture
xlRange.Copy
wdRange.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile


Set wdRange = Nothing
Set xlRange = Nothing
Set xlApp = Nothing

End Sub


Hope this helps.

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word

 

[Alex St-Pierre]

Hi Shauna,
I can't paste the table as a picture because formatting is not perfect.
Example: in Excel, the borders allow only 3 sizes (thin,med or large) but in
Word, I want to format the line width as 025 pt, med as 150 pt, etc.
Also, picture create different size character when you resize it to fit the
entire page.

What I will do is (as suggested by heretic):
1- copy-paste the table directly in Word (Can I be sure that the character
size will be respected in word ?)
2- By doing this, I see that the line in excel that takes 2 columns (merged
or not) is automatically merged in Word table. I don't know if I will really
need to use Range.information command.
An important things here is to know which cells are merged in word. I can't
really know in excel if the cell has been merged in word ? I could count, for
each row, how many cells in word and excel table and then, try to find which
is merged?
Example: to format my borders, if the table has 3 columns in excel and
column 1 and 2 are merged. Cells(1,3) in excel will refer the column #3 in
excel but the column #2 in word. tbl.cells(1,2) = rngexcel.cells(1,3)
For i = 1 To tbl.Rows.Count 'word table
For j = 1 To tbl.Columns.Count 'Shoud write: tbl.Rows(i).Cells.Count
If rngExcel.Cells(i, j).LineStyle = xlContinuous Then
tbl.Cell(i, j).Borders(wdBorderTop).LineStyle =
wdLineStyleSingle
Next j
Next i
3- I will use the object explorer to compare table before and after the
paste. This will say what as change.
4- The numbers formats is respected when I make a copy and paste. I have to
adjust alignment for negative number () to align the numbers. ex:
1 000
(3 000) 'this is done with:
If Right(tbl.cell(i,j), 1) = ")" Then 'and the cell Isnumber in
excel then
tbl.Cell(i, j).Select
With Selection.ParagraphFormat
.RightIndent = CentimetersToPoints(-0.13)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
End if

Is there a place where I can find documentation about the column width ?
I use a prorata to adjust my column width.
What I'm doing is: if column width = 80 in excel, this is corresponding with
432 units in word. Is there a better way to match column size ?

With tbl.Rows
.LeftIndent = 0
End With

UsableWidth = 432
TableWidth = 0
For CellNo = 1 To rngExcel.Rows(1).Cells.Count
TableWidth = TableWidth + rngExcel.Columns(CellNo).ColumnWidth
Next CellNo

For j = 1 To tbl.Columns.Count
For i = 1 To tbl.Rows.Count
tbl.Cell(i, j).Width = UsableWidth * rngExcel.Columns(j).ColumnWidth
/ TableWidth
Next i
Next j

Thanks !

 

[Shauna Kelly]

Hi Alex

I think you have an extraordinarily difficult task ahead of you. Here are
comments on some of your questions:

Can I be sure that the character size will be respected in word ?

Almost certainly not. See
Why does text change format when I copy it into another document?
http://www.ShaunaKelly.com/word/styles/FormatOfTextChanges.html

Is there a place where I can find documentation about the column width ?

There is little comparability between Word and Excel column widths.

Word measures its column widths in points (expressed through the UI as
centimetres, inches, points, character units etc, at the user's choice).

Excel measures column widths in multiples of the width of the "0" (zero)
character in the font used for the Normal Style for that workbook. (True! To
prove it, change the font size of the normal style in a workbook, and
observe that the apparent widths of the columns change). In Excel, you can
read and write Activesheet.Columns("A").ColumnWidth in the units displayed
in the user interface. In Excel you can read (but not write)
Activesheet.Columns("A").Width, which returns a measurement in points. The
..Width property might be more useful for you.

Hope this helps.

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word

 

[cheng_koko]

Hi,
Does anyone has already reproduce an excel table in word. I'm trying to do
that (the programmation is below) but it is very complex. I'm looking for
information to help me to progress.

What the program do is a mailmerge executed from Excel. The excel file
contains a sheet for mail merge data and others sheets (table1.1, table1.2,
etc.) for tables used in the mailmerge document. When I execute the macro in
excel, the Word Macro is executed and all the tables are formatted in word
just before the mailmerge execution.

The table formating seems to be very complex because:
1) Text with bold and exponents, italic, size caracter, ...
tbl.cell(i,j) = rngExcel.Cells(i, j).Format 'give format of the first
character and not of all character. Does anyone know how to paste all cell
formatting in word? I don't know if doing a copy and paste is the best
solution because, some cells are merged in excel and I have to adjust
formatting (borders,horizontal alignment) thereafter.
2) In excel table, some cell contains text that go on the following cells. I
have to merge the table cells in Word to take this into account. Also, it is
possible that the cells are merge in excel.
3) Want to respect column width, borders, alignment etc.
4) I added a section to take NumberFormat from Excel.
etc.

Does anyone have already done something similar to this ?
Is there a simpler way to have great word table formatting without having to
program each things? example: copy paste the table using a pre-determined
table formating. After that, adjust borders, column width, some alignments, ..

Thanks a lot !

Alex

Sub Merge_Word()
Dim appWord As Word.Application
Dim docWord1 As Word.Document
Dim docWord2 As Word.Document
Dim appExcel As Excel.Application
Dim wbExcel As Excel.Workbook

Dim tbl As Word.Table
Dim oRow As Row
Dim rngExcel As Excel.Range
Dim pathExcel, strFormat, strBookMark As String
Dim iCol As Integer

Set appWord = Word.Application
Set docWord1 = appWord.ActiveDocument

On Error Resume Next
Set appExcel = GetObject(, "Excel.Application")
If appExcel Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
End If
On Error GoTo 0

pathExcel = appExcel.ActiveWorkbook.Path & "\" &
appExcel.ActiveWorkbook.Name
' PathExcel = ActiveDocument.MailMerge.DataSource.Name
fileExcel = LCase(Right(pathExcel, Len(pathExcel) - InStrRev(pathExcel,
"\")))


On Error Resume Next
Set wbExcel = appExcel.Workbooks(fileExcel)
If wbExcel Is Nothing Then
Set wbExcel = appExcel.Workbooks.Open(FileName:=pathExcel,
UpdateLinks:=True, ReadOnly:=True)
' Set wbExcel = GetObject(PathExcel, "Excel.Workbook")
End If
On Error GoTo 0

For nbTab = 1 To 3

If nbTab = 1 Then
Set rngExcel = wbExcel.Application.sheets("table1.1").Range("table1_1")
Set rng = docWord1.Bookmarks("Table1_1").Range
ElseIf nbTab = 2 Then
Set rngExcel = wbExcel.Application.sheets("table1.2").Range("table1_2")
Set rng = docWord1.Bookmarks("Table1_2").Range
ElseIf nbTab = 3 Then
Set rngExcel = wbExcel.Application.sheets("table1.3").Range("table1_3")
Set rng = docWord1.Bookmarks("Table1_3").Range
End If

Set tbl = rng.Tables(1)

'1- Adjust number of rows
DerLineExcel = rngExcel.Rows.Count
DerLineWord = tbl.Rows.Count
j = DerLineExcel - DerLineWord

For k = 1 To j
tbl.Rows.Add
Next k
For k = 1 To -j
tbl.Cell(5, 1).Select
Selection.SelectRow
Selection.Rows.Delete
Next k

'2- Adjust number of columns

'3- Adjust column width
With tbl.Rows
.LeftIndent = 0
End With

UsableWidth = 432
TableWidth = 0
For CellNo = 1 To rngExcel.Rows(1).Cells.Count
TableWidth = TableWidth + rngExcel.Columns(CellNo).ColumnWidth
Next CellNo

For j = 1 To tbl.Columns.Count
For i = 1 To tbl.Rows.Count
tbl.Cell(i, j).Width = UsableWidth * rngExcel.Columns(j).ColumnWidth
/ TableWidth
Next i
Next j

'4- MergeCells
For i = 1 To rngExcel.Rows.Count
j = 1
Do Until j >= rngExcel.Columns.Count
With rngExcel
If .Cells(i, j).MergeCells = True Then
iCol = .Cells(i, j).MergeArea.Columns.Count
tbl.Cell(i, j).Select
Selection.MoveRight Unit:=wdCharacter, Count:=iCol - 1, Extend:=wdExtend
Selection.Cells.Merge
j = j + iCol
Else
j = j + 1
End If
End With
Loop 'j
Next i

'5- Remove all borders
With tbl
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
End With

'6- Add borders
With tbl
For i = 1 To tbl.Rows.Count
For j = 1 To tbl.Columns.Count

With rngExcel.Cells(i, j)
With .Borders(xlEdgeTop)
If .LineStyle = xlContinuous Then
C = wdLineStyleSingle
tbl.Cell(i, j).Borders(wdBorderTop).LineStyle =
wdLineStyleSingle
If .Weight = xlThin Then
tbl.Cell(i, j).Borders(wdBorderTop).LineWidth =
wdLineWidth025pt
ElseIf .Weight = xlMedium Then
tbl.Cell(i, j).Borders(wdBorderTop).LineWidth =
wdLineWidth150pt
Else
'MsgBox ("non defined excel border")
End If
Else
tbl.Cell(i, j).Borders(wdBorderTop).LineStyle =
wdLineStyleNone
End If
End With
With .Borders(xlEdgeBottom)
If .LineStyle = xlContinuous Then
tbl.Cell(i, j).Borders(wdBorderBottom).LineStyle =
wdLineStyleSingle
If .Weight = xlThin Then
tbl.Cell(i, j).Borders(wdBorderBottom).LineWidth =
wdLineWidth025pt
ElseIf .Weight = xlMedium Then
tbl.Cell(i, j).Borders(wdBorderBottom).LineWidth =
wdLineWidth150pt
Else
'MsgBox ("non defined excel border")
End If
Else
tbl.Cell(i, j).Borders(wdBorderBottom).LineStyle =
wdLineStyleNone
End If
End With
With .Borders(xlEdgeLeft)
If .LineStyle = xlContinuous Then
tbl.Cell(i, j).Borders(wdBorderLeft).LineStyle =
wdLineStyleSingle
If .Weight = xlThin Then
tbl.Cell(i, j).Borders(wdBorderLeft).LineWidth =
wdLineWidth025pt
ElseIf .Weight = xlMedium Then
tbl.Cell(i, j).Borders(wdBorderLeft).LineWidth =
wdLineWidth150pt
Else
'MsgBox ("non defined excel border")
End If
Else
tbl.Cell(i, j).Borders(wdBorderLeft).LineStyle =
wdLineStyleNone
End If
End With
With .Borders(xlEdgeRight)
If .LineStyle = xlContinuous Then
tbl.Cell(i, j).Borders(wdBorderRight).LineStyle =
wdLineStyleSingle
If .Weight = xlThin Then
tbl.Cell(i, j).Borders(wdBorderRight).LineWidth =
wdLineWidth025pt
ElseIf .Weight = xlMedium Then
tbl.Cell(i, j).Borders(wdBorderRight).LineWidth =
wdLineWidth150pt
Else
'MsgBox ("non defined excel border")
End If
Else
tbl.Cell(i, j).Borders(wdBorderRight).LineStyle =
wdLineStyleNone
End If
End With
End With

'With Selection.ParagraphFormat
' .LeftIndent = CentimetersToPoints(0)
' .SpaceBeforeAuto = False
' .SpaceAfterAuto = False
'End With

'7- Add data with formating
strData = rngExcel.Cells(i, j)
If IsNumeric(strData) And strData <> "" Then
strFormat = rngExcel.Cells(i, j).NumberFormat
If strFormat = "#,##0_);(#,##0)" Or strFormat = "# ##0_-;(#
##0)" Or strFormat = "#,##0_-;(#,##0)" Then ' voir ajout de n'importe quel _)
strFormat = "#,##0;(#,##0)"
End If
strData = Format(strData, strFormat)
If Right(strData, 1) = ")" Then
.Cell(i, j).Select
With Selection.ParagraphFormat
.RightIndent = CentimetersToPoints(-0.13)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
Else
.Cell(i, j).Select
With Selection.ParagraphFormat
.RightIndent = CentimetersToPoints(0)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
End If ')"
End If 'IsNumeric
.Cell(i, j).Range.text = strData
Next j
Next i
End With

Next nbTab

Exit Sub

'8- Add text to document
strBookMark = wbExcel.Path & "\bookmark1.doc"
Set docWord2 = appWord.Documents.Open(strBookMark, ReadOnly:=False)
docWord2.Bookmarks(1).Range.Select
Selection.Copy
docWord1.Bookmarks("Bookmark1").Range.Select
Selection.Paste
docWord2.Close

'9- Mailmerge execution
With docWord1.MailMerge

ActiveDocument.MailMerge.OpenDataSource Name:= _
pathExcel, ConfirmConversions:=False, ReadOnly:= _
True, LinkToSource:=True, AddToRecentFiles:=False,
PasswordDocument:="", _
PasswordTemplate:="", WritePasswordDocument:="",
WritePasswordTemplate:= _
"", Revert:=False, Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data
Source=C:\rap_modele_ameliorations.xls;Mode=Read;Extended
Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet OLEDB:Engine " _
, SQLStatement:="SELECT * FROM `merge$`", SQLStatement1:="",
SubType:= _
wdMergeSubTypeAccess

.Destination = wdSendToNewDocument