Birch81
09-22-2010, 11:11 PM
Hello,
I have a problem underlining my table.
I have to besides laying cells that has to be underlined with either a single or a double line. The underlining is not the problem. My problem is that when I have underlined those two cells there is a space between lines?
How do I solve this problem?
Here is some of my code. If you need more I will post it.
Sub CreateTable(strHeader As String, colRange As range, bookmark As String)
Dim table As Word.table
Dim ActiveRows As Integer
Dim offSetRow As Integer
Dim rowCounter As Integer
Dim cellCounter As Integer
Dim krCounter As Integer
Dim sum As String
Dim dummy As String
Dim productType As String
Dim test As Integer
ActiveRows = 0
krCounter = 0
cellCounter = 1
offSetRow = 1
rowCounter = 1
If strHeader <> "" Then
ActiveRows = 1
Else
ActiveRows = 0
End If
For i = 0 To colRange.Rows.Count 'Counts Active Rows
If colRange.Cells(i, 5).Value <> "" And colRange.Cells(i, 5).Value <> 0 Then
ActiveRows = ActiveRows + 1
Else
ActiveRows = ActiveRows
End If
Next
Set table = CreateNewTable(ActiveRows, bookmark) 'Create Table
With table
If strHeader <> "" Then
With .Cell(1, 1).range
.InsertAfter strHeader
.Underline = 1
offSetRow = 2
End With
End If
For Each Cell In colRange
Select Case True
Case cellCounter Mod 5 = 0
sum = Cell
Case cellCounter Mod 4 = 0
dummy = Cell
Case cellCounter Mod 3 = 0
price = Cell
Case cellCounter Mod 2 = 0
nummer = Cell
Case cellCounter Mod 1 = 0
productType = Cell
End Select
If cellCounter Mod 5 = 0 Then
If (Len(sum) <> 0 And Len(sum) <> 1) And sum <> "" Then
With .Cell(offSetRow, 1).range
.InsertAfter DefineProductStrings(productType, nummer, price, strHeader) 'productType 'TestType
End With
With .Cell(offSetRow, 2).range
If krCounter = 0 Or DefineProductStrings(productType, nummer, price, strHeader) = "Ialt" Then
.InsertAfter "kr. "
If bookmark <> "TblTotal" Then
If strHeader <> "" Then
If ActiveRows = offSetRow Then 'Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
End If
End If
ElseIf bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
ElseIf ActiveRows = offSetRow Then
'.Font.Underline = wdUnderlineDouble
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
End If
End If
Else
.InsertAfter " - "
If bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
End If
End If
'If bookmark <> "TblTotal" Then
' If strHeader <> "" Then
' If ActiveRows - 1 = offSetRow Then
' .Font.Underline = wdUnderlineSingle
' End If
' End If
'End If
End If
krCounter = krCounter + 1
End With
With .Cell(offSetRow, 3).range
If krCounter = 0 Or DefineProductStrings(productType, nummer, price, strHeader) = "Ialt" Then
.InsertAfter Format(sum, "##,##0.00")
.ParagraphFormat.Alignment = wdAlignParagraphRight
If bookmark <> "TblTotal" Then
If strHeader <> "" Then
If ActiveRows = offSetRow Then 'Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
End If
End If
ElseIf bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
ElseIf ActiveRows = offSetRow Then
'.Font.Underline = wdUnderlinedouble
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
End If
End If
Else
.InsertAfter Format(sum, "##,##0.00")
.ParagraphFormat.Alignment = wdAlignParagraphRight
If bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
'ParagraphFormat.Borders(wdBorderBottom).LineStyle =wdLineStyleSingle.InsertParagraphAfter
End If
End If
'If bookmark <> "TblTotal" Then
' If strHeader <> "" Then
' If ActiveRows - 1 = offSetRow Then
' .Font.Underline = wdUnderlineSingle
' End If
' End If
'End If
End If
End With
End If
cellCounter = 0
If (Len(sum) <> 0 And Len(sum) <> 1) And sum <> "" Then
offSetRow = offSetRow + 1
Else
offSetRow = offSetRow
End If
End If
cellCounter = cellCounter + 1
Next
rowCounter = rowCounter + 1
End With
End Sub
Thanks in advance
I have a problem underlining my table.
I have to besides laying cells that has to be underlined with either a single or a double line. The underlining is not the problem. My problem is that when I have underlined those two cells there is a space between lines?
How do I solve this problem?
Here is some of my code. If you need more I will post it.
Sub CreateTable(strHeader As String, colRange As range, bookmark As String)
Dim table As Word.table
Dim ActiveRows As Integer
Dim offSetRow As Integer
Dim rowCounter As Integer
Dim cellCounter As Integer
Dim krCounter As Integer
Dim sum As String
Dim dummy As String
Dim productType As String
Dim test As Integer
ActiveRows = 0
krCounter = 0
cellCounter = 1
offSetRow = 1
rowCounter = 1
If strHeader <> "" Then
ActiveRows = 1
Else
ActiveRows = 0
End If
For i = 0 To colRange.Rows.Count 'Counts Active Rows
If colRange.Cells(i, 5).Value <> "" And colRange.Cells(i, 5).Value <> 0 Then
ActiveRows = ActiveRows + 1
Else
ActiveRows = ActiveRows
End If
Next
Set table = CreateNewTable(ActiveRows, bookmark) 'Create Table
With table
If strHeader <> "" Then
With .Cell(1, 1).range
.InsertAfter strHeader
.Underline = 1
offSetRow = 2
End With
End If
For Each Cell In colRange
Select Case True
Case cellCounter Mod 5 = 0
sum = Cell
Case cellCounter Mod 4 = 0
dummy = Cell
Case cellCounter Mod 3 = 0
price = Cell
Case cellCounter Mod 2 = 0
nummer = Cell
Case cellCounter Mod 1 = 0
productType = Cell
End Select
If cellCounter Mod 5 = 0 Then
If (Len(sum) <> 0 And Len(sum) <> 1) And sum <> "" Then
With .Cell(offSetRow, 1).range
.InsertAfter DefineProductStrings(productType, nummer, price, strHeader) 'productType 'TestType
End With
With .Cell(offSetRow, 2).range
If krCounter = 0 Or DefineProductStrings(productType, nummer, price, strHeader) = "Ialt" Then
.InsertAfter "kr. "
If bookmark <> "TblTotal" Then
If strHeader <> "" Then
If ActiveRows = offSetRow Then 'Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
End If
End If
ElseIf bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
ElseIf ActiveRows = offSetRow Then
'.Font.Underline = wdUnderlineDouble
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
End If
End If
Else
.InsertAfter " - "
If bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
End If
End If
'If bookmark <> "TblTotal" Then
' If strHeader <> "" Then
' If ActiveRows - 1 = offSetRow Then
' .Font.Underline = wdUnderlineSingle
' End If
' End If
'End If
End If
krCounter = krCounter + 1
End With
With .Cell(offSetRow, 3).range
If krCounter = 0 Or DefineProductStrings(productType, nummer, price, strHeader) = "Ialt" Then
.InsertAfter Format(sum, "##,##0.00")
.ParagraphFormat.Alignment = wdAlignParagraphRight
If bookmark <> "TblTotal" Then
If strHeader <> "" Then
If ActiveRows = offSetRow Then 'Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
End If
End If
ElseIf bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
ElseIf ActiveRows = offSetRow Then
'.Font.Underline = wdUnderlinedouble
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleDouble
End If
End If
Else
.InsertAfter Format(sum, "##,##0.00")
.ParagraphFormat.Alignment = wdAlignParagraphRight
If bookmark = "TblTotal" Then
If ActiveRows - 3 = offSetRow Or ActiveRows - 1 = offSetRow Then
'.Font.Underline = wdUnderlineSingle
.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
'ParagraphFormat.Borders(wdBorderBottom).LineStyle =wdLineStyleSingle.InsertParagraphAfter
End If
End If
'If bookmark <> "TblTotal" Then
' If strHeader <> "" Then
' If ActiveRows - 1 = offSetRow Then
' .Font.Underline = wdUnderlineSingle
' End If
' End If
'End If
End If
End With
End If
cellCounter = 0
If (Len(sum) <> 0 And Len(sum) <> 1) And sum <> "" Then
offSetRow = offSetRow + 1
Else
offSetRow = offSetRow
End If
End If
cellCounter = cellCounter + 1
Next
rowCounter = rowCounter + 1
End With
End Sub
Thanks in advance