合并单元格实战

请先打开CaseStyudy目录下的文件"PDFCreator示例.Table"后再运行本节的示例代码。

示例一

本节的任务是用PDFCreator生成下图所示的员工资料卡：

我们可以在上一节的基础上，增加一个二维数组表示单元格内容，例如"姓名"表示普通的字符串"姓名"，而"[姓名]"表示从姓名列中提取员工姓名，"{照片}"表示要从照片列中获取员工照片进行绘制 ，""表示跳过这个单元格(例如哪些已经被合并的单元格)，规则可以自定定义，不一定要按照我的来。

基于上面的规则，这个表格的内容可以用一个二维数组表示：

Dim contents(, ) As String = {
{"姓名", "[姓名]", "出生日期", "[出生日期]", "{照片}"},
{"部门", "[部门]", "雇佣日期", "[雇佣日期]", ""},
{"性别", "[性别]", "职务", "[职务]", ""},
{"地址", "[地址]", "", "", ""},
{"家庭电话", "[家庭电话]", "办公电话", "[办公电话]", ""},
{"[备注]", "", "", "", ""}
}

下面是完整的代码，我再次强调：代码有点长，但这个代码是通用的，不管多复杂的表格，你 都不需要修改代码，你要做的都只是修改前面的数组定义：

'定义一个二维数组，一个元素对应一个单元格
Dim cells(,)As String = {
{"1", "1", "1", "1", "5,1"},
{"1", "1", "1", "1", "0"},
{"1", "1", "1", "1", "0"},
{"1", "1,3", "0", "0", "0"},
{"1", "1", "1", "1", "0"},
{"1,5", "0", "0", "0", "0"}
}
'定义一个二维数组，用于表示单元格内容
Dim contents(,) As String = {
{"姓名", "[姓名]", "出生日期", "[出生日期]", "{照片}"},
{"部门", "[部门]", "雇佣日期", "[雇佣日期]", ""},
{"性别", "[性别]", "职务", "[职务]", ""},
{"地址", "[地址]", "", "", ""},
{"家庭电话", "[家庭电话]", "办公电话", "[办公电话]", ""},
{"[备注]", "", "", "", ""}
}
Dim defaultRowHeight As Integer = 28 '默认(单倍)行高
Dim colWidths() As Double = {54, 128, 54, 128, 124} '各列宽度
Dim rowTimes() As Integer = {1, 1, 1, 1, 1, 3} '各行的行高倍数，第6行为3倍行高，其他为默认(单倍)行高

'下面的代码是通用的，不管表格如何变化，你基本都不需要修改代码，只需修改前面的各数组即可：
Dim file As String = "c:\temp\test.pdf"
Dim pdc As New PDFCreator()
Dim rectPage As RectangleF = pdc.PageRectangle
rectPage.Inflate( - 72, - 72)
 '绘制标题
Dim title As String = "员工资料卡"
Dim titleFont As New Font("微软雅黑", 16, fontstyle.Bold)
Dim sf As New StringFormat()
sf.Alignment = StringAlignment.Center
pdc.DrawString(title, titlefont, color.Black, rectpage, sf)
Dim rectCell As RectangleF = rectPage
'绘制表格
rectCell.Y = rectCell.Y + pdc.MeasureString(title, titleFont, rectPage.Width).Height + 15 '标题之后15磅为表格
Dim tRow As Row = Tables("员工").Current '获取要打印的员工
Dim contentFont As New Font("微软雅黑", 10)
sf.Alignment = StringAlignment.Near '单元格内容水平靠左
For r As Integer = 0 To cells.GetLength(0) - 1 '逐行绘制
    For c As Integer = 0 To cells.GetLength(1) - 1 '绘制这一行的单元格
        Dim ifo As String = cells(r, c)
        Dim cellHeight As Double = 0 '单元格高度
        Dim cellWidth As Double = 0 '单元格宽度
        sf.LineAlignment = StringAlignment.Center '单元格内容默认垂直居中
        If rowTimes(r) > 1 Then
            sf.LineAlignment = StringAlignment.Near '如果多倍行高，则单元格内容垂直靠上对齐
        End If
        If ifo = "0" OrElse ifo = "1" Then
            cellHeight = defaultRowHeight * rowTimes(r) '根据行高倍数计算单元格高度
            cellWidth = colWidths(c) '取列宽为单元格宽度
        Else '如果是合并单元格
            Dim vls() As String = cells(r, c).Split(",")
            For mr As Integer = r To r + CInt(vls(0)) - 1 '根据合并行数计算单元格高度
                cellHeight = cellHeight + defaultRowHeight * rowTimes(mr)
            Next
            For mc As Integer = c To c + CInt(vls(1)) - 1 '根据合并列数计算单元格宽度
                cellWidth = cellWidth + colWidths(mc)
            Next
        End If
        If ifo <> "0" Then '绘制单元格
            rectCell.Height = cellHeight
            rectCell.Width = cellWidth
            Dim content As String = contents(r, c) '从二维数组获取单元格内容
            If content > "" Then '如果有内容
                Dim rectContent As RectangleF = rectCell
                rectContent.Inflate( - 3, - 3) '单元格内容边距为3磅
                If content.StartsWith("[") AndAlso content.EndsWith("]") Then '如果是[列名]格式
                    content = tRow(content.Trim("[", "]")) '获取列内容，注意先要去掉首尾的方括号
                End If
                If content.StartsWith("{") AndAlso content.EndsWith("}") Then '如果是{列名}格式
                    Dim img As Image = GetImage(tRow(content.Trim("{", "}"))) '获取图片，注意先要去掉首尾的大括号
                    pdc.DrawImage(img, rectContent, ContentAlignment.MiddleCenter, PDF.ImageSizeModeEnum.Scale) '绘制图片
                Else
                    pdc.DrawString(content, contentFont, color.Black, rectContent, sf) '绘制单元格文本
                End If
            End If
            pdc.DrawRectangle(pens.Black, rectCell) '绘制单元格边框
        End If
        rectCell.Offset(colWidths(c), 0) '右移单元格
    Next
    rectCell.Offset(0, defaultRowHeight * rowTimes(r)) '移到下一行
    rectCell.X = rectPage.X '单元格回到水平初始位置，准备绘制下一行
Next
pdc.Save(file) '保存文件
Process.Start(file) '打开文件

示例二

前面我给的只是一个示例，你可以自由发挥，例如加入更多的二维数组对单元格进行其他设置。

二维数组针对的是普遍性的设置，也就是大部分单元格都需要的设置，如果设置只是针对个别单元格，或者只针对来自于某些字段的内容，此时用字典或集合更好。

例如你可以给几个特别的单元格指定不一样的背景颜色，可以增加一个字典，字典的键值为"r,c"格式，表示第r行第c列，字典的值为颜色，例如：

Dim cellColors As New Dictionary(Of String, Color)
cellColors.Add("1,1", color.Beige) '指定第二行第二列的背景颜色
cellColors.Add("2,3", color.GreenYellow) '指定第三行第四例的背景颜色

然后在绘制单元格边框的代码前面加上：

If cellColors.ContainsKey(r & "," & c) Then
    pdc.FillRectangle(cellColors(r & "," & c), rectCell) '填充单元格背景颜色，要先填充再绘制边框
End If
pdc.DrawRectangle(pens.Black, rectCell) '原来绘制边框的代码

再例如你希望职务和性别两个单元格的数据用红字显示，那么可以用一个集合，这个集合包括所有希望用红字显示的字段名：

Dim redFileds As New List(Of String) '一个集合，包括所有希望用红字的字段名
redFileds.Add("职务")
redFileds.Add("性别")

下面给出了完整的示例代码，总之没有什么是一成不变的，规则由你不由我：

'定义一个二维数组，一个元素对应一个单元格
Dim cells(, )As String = {
{"1", "1", "1", "1", "5,1"},
{"1", "1", "1", "1", "0"},
{"1", "1", "1", "1", "0"},
{"1", "1,3", "0", "0", "0"},
{"1", "1", "1", "1", "0"},
{"1,5", "0", "0", "0", "0"}
}
'定义一个二维数组，用于表示单元格内容
Dim contents(, ) As String = {
{"姓名", "[姓名]", "出生日期", "[出生日期]", "{照片}"},
{"部门", "[部门]", "雇佣日期", "[雇佣日期]", ""},
{"性别", "[性别]", "职务", "[职务]", ""},
{"地址", "[地址]", "", "", ""},
{"家庭电话", "[家庭电话]", "办公电话", "[办公电话]", ""},
{"[备注]", "", "", "", ""}
}
Dim defaultRowHeight As Integer = 28 '默认(单倍)行高
Dim colWidths() As Double = {54, 128, 54, 128, 124} '各列宽度|
Dim rowTimes() As Integer = {1, 1, 1, 1, 1, 3} '各行的行高倍数，第6行为3倍行高，其他为默认(单倍)行高
Dim cellColors As New Dictionary(Of String, Color)
Dim redFileds As New List(Of String) '一个集合，包括所有希望用红字显示的字段名
redFileds.Add("职务")
redFileds.Add("性别")

'下面的代码是通用的，不管表格如何变化，你基本都不需要修改代码，只需修改前面的各数组即可：
Dim file As String = "c:\temp\test.pdf"
Dim pdc As New PDFCreator()
Dim rectPage As RectangleF = pdc.PageRectangle
rectPage.Inflate( - 72, - 72)
'绘制标题
Dim title As String = "员工资料卡"
Dim titleFont As New Font("微软雅黑", 16, fontstyle.Bold)
Dim sf As New StringFormat()
sf.Alignment = StringAlignment.Center
pdc.DrawString(title, titlefont, color.Black, rectpage, sf)
Dim rectCell As RectangleF = rectPage
'绘制表格
rectCell.Y = rectCell.Y + pdc.MeasureString(title, titleFont, rectPage.Width).Height + 15 '标题之后15磅为表格
Dim tRow As Row = Tables("员工").Current '获取要打印的员工
Dim contentFont As New Font("微软雅黑", 10)
sf.Alignment = StringAlignment.Near '单元格内容水平靠左
For r As Integer = 0 To cells.GetLength(0) - 1 '逐行绘制
    For c As Integer = 0 To cells.GetLength(1) - 1 '绘制这一行的单元格
        Dim ifo As String = cells(r, c)
        Dim cellHeight As Double = 0 '单元格高度
        Dim cellWidth As Double = 0 '单元格宽度
        sf.LineAlignment = StringAlignment.Center '单元格内容默认垂直居中
        If rowTimes(r) > 1 Then
            sf.LineAlignment = StringAlignment.Near '如果多倍行高，则单元格内容垂直靠上对齐
        End If
        If ifo = "0" OrElse ifo = "1" Then
            cellHeight = defaultRowHeight * rowTimes(r) '根据行高倍数计算单元格高度
            cellWidth = colWidths(c) '取列宽为单元格宽度
        Else '如果是合并单元格
            Dim vls() As String = cells(r, c).Split(",")
            For mr As Integer = r To r + CInt(vls(0)) - 1 '根据合并行数计算单元格高度
                cellHeight = cellHeight + defaultRowHeight * rowTimes(mr)
            Next
            For mc As Integer = c To c + CInt(vls(1)) - 1 '根据合并列数计算单元格宽度
                cellWidth = cellWidth + colWidths(mc)
            Next
        End If
        If ifo <> "0" Then '绘制单元格
            rectCell.Height = cellHeight
            rectCell.Width = cellWidth
            Dim content As String = contents(r, c) '从二维数组获取单元格内容
            If content > "" Then '如果有内容
                Dim foreColor As Color = Color.Black '默认为黑色文字
                Dim rectContent As RectangleF = rectCell
                rectContent.Inflate( - 3, - 3) '单元格内容边距为3磅
                If content.StartsWith("[") AndAlso content.EndsWith("]") Then '如果是[列名]格式
                    Dim colName As String = content.Trim("[", "]")
                    If redFileds.Contains(colName) Then '如果字段名在集合redFileds中
                        foreColor = Color.Red '红色文字
                    End If
                    content = tRow(colName) '获取列内容，注意先要去掉首尾的方括号
                End If
                If content.StartsWith("{") AndAlso content.EndsWith("}") Then '如果是{列名}格式
                    Dim img As Image = GetImage(tRow(content.Trim("{", "}"))) '获取图片，注意先要去掉首尾的大括号
                    pdc.DrawImage(img, rectContent, ContentAlignment.MiddleCenter, PDF.ImageSizeModeEnum.Scale) '绘制图片
                Else
                    pdc.DrawString(content, contentFont, foreColor, rectContent, sf) '绘制单元格文本
                End If
            End If
            pdc.DrawRectangle(pens.Black, rectCell) '绘制单元格边框
        End If
        rectCell.Offset(colWidths(c), 0) '右移单元格
    Next
    rectCell.Offset(0, defaultRowHeight * rowTimes(r)) '移到下一行
    rectCell.X = rectPage.X '单元格回到水平初始位置，准备绘制下一行
Next
pdc.Save(file) '保存文件
Process.Start(file) '打开文件

生成的文档为：