这是我第一次发Office开发相关的帖子。说到Office开发，我只能算新手。这次是碰巧开发了一个Excel智能文档项目，其中用到了这个小小的技巧，就发出来让大家看看。
在Excel开发中，工作表上最基本也是最常用的元素就是Range，Range可以表达一个获任意多个单元格或者矩形区域的组合，其复杂程度相当高。如果我们的智能文档程序要与用户打交道的话，势必要编程控制文档中的单元格，或与用户选择的单元格交互。而Range的对象模型并不符合.NET开发人员的习惯，要想获取用户选中区域的形状或者操作特定形状的区域都十分繁琐。而MSDN和VSTO的推销人员们只关心诸如怎么把单元格和数据源或者XML绑定之类，这种“小事”只能靠我们自己动手了。我的任务就是编写一个Range的封装类，将Range中所有单元格和矩形区域转化为易于访问的对象模型。首先我们看看Range的组成，一个普通的Range可以是一个或多个矩形区域的集合，每个矩形区域都由一组连续的列和连续的行组成。其中行使用阿拉伯数字索引，而列采用字母索引。如图所示：
注意，多个矩形区域可以不连续，还可以交叠。每个Range都有一个描述其位置的字符串，称为Range的地址字符串。地址字符串不但包含所有位置信息，还可以被Excel用来直接快速定位，所以我们就以地址字符串为桥梁，编写我们的包装类。
ColumnWrapper类：主要用于吧表示列的字符串“A”，“B”，“AA”等转化为1开始的整数序列，或者相反。我这里用到的算法可以支持无限大的整数与列名字符串互转，但其实Excel只支持到256列。
ColumnWrapperPublic Class ColumnWrapperClass ColumnWrapper
Private Const c_NameChar = " ABCDEFGHIJKLMNOPQRSTUVWXYZ" Private indexValue As Integer
Public ReadOnly Property Index()Property Index() As Integer Get Return indexValue End Get
End Property Private nameValue As String Public ReadOnly Property Name()Property Name() As String Get Return nameValue End Get End Property Public Sub New()Sub New(ByVal name As String) nameValue = name indexValue = GetIndex(name) End Sub Private Function GetName()Function GetName(ByVal i As Integer) As String Debug.Assert(i > 0) Dim left As Integer = (i - 1) \ 26 Dim right As Integer = i Mod 26 Dim nameLeft As String Dim nameRight As String If left > 0 Then nameLeft = GetName(left) Else nameLeft = String.Empty End If If right = 0 Then right = 26 nameRight = c_NameChar(right) Return nameLeft & nameRight End Function Private Function GetIndex()Function GetIndex(ByVal name As String) As Integer Debug.Assert(Not String.IsNullOrEmpty(name)) Dim len As Integer = name.Length Dim bit As Integer = 1 For i As Integer = len - 1 To 0 Step -1 Dim c As Char = name(i) Dim val = c_NameChar.IndexOf(Char.ToUpper(c)) GetIndex += bit * val bit *= 26 Next End Function Public Sub New()Sub New(ByVal index As Integer) nameValue = GetName(index) indexValue = index End Sub Public Overrides Function GetHashCode()Function GetHashCode() As Integer Return indexValue End Function Public Overrides Function Equals()Function Equals(ByVal obj As Object) As Boolean If obj Is Nothing Then Return False Return TryCast(obj, ColumnWrapper).indexValue = indexValue End Function
End Class有了ColumnWrapper，下面就是CellWrapper，表示单个单元格。
CellWrapperPublic Class CellWrapperClass CellWrapper Private addr As String Public ReadOnly Property Address()Property Address() As String Get Return addr End Get End Property Private rowValue As Integer Public ReadOnly Property RowIndex()Property RowIndex() As Integer Get Return rowValue End Get End Property Private columnValue As ColumnWrapper Public ReadOnly Property Column()Property Column() As ColumnWrapper Get Return columnValue End Get End Property Private cellValue As String Public ReadOnly Property Value()Property Value() As String Get Return cellValue End Get End Property Public Sub New()Sub New(ByVal row As Integer, ByVal column As ColumnWrapper) rowValue = row columnValue = column Me.addr = "$" & column.Name & "$" & row End Sub Private Shared rx As New Regex("\$([A-Z]+)\$([1-9][0-9]*)", RegexOptions.Compiled) Public Sub New()Sub New(ByVal address As String) Me.addr = address Dim matches As MatchCollection = rx.Matches(address) If matches.Count = 0 Then Throw New ArgumentException("address") Dim firstMatch As Match = matches(0) Me.columnValue = New ColumnWrapper(firstMatch.Groups(1).Value) Me.rowValue = Integer.Parse(firstMatch.Groups(2).Value) End SubEnd Class接下来我们要表示矩形区域RectRangeWrapper。我们用来表示矩形区域。当我们需要计算矩形区域的大小时，只要使用着两个角单元格的位置信息即可算出。
RectRangeWrapperPublic Class RectRangeWrapperClass RectRangeWrapper Private addr As String Public ReadOnly Property Address()Property Address() As String Get Return addr End Get End Property Private isWide As Boolean = False Public ReadOnly Property IsWideRange()Property IsWideRange() As Boolean Get Return isWide End Get End Property Private leftTop As CellWrapper Public ReadOnly Property LeftTopCell()Property LeftTopCell() As CellWrapper Get Return leftTop End Get End Property Private rightBottom As CellWrapper Public ReadOnly Property RightBottomCell()Property RightBottomCell() As CellWrapper Get Return rightBottom End Get End Property Public ReadOnly Property Width()Property Width() As Integer Get Return Me.rightBottom.Column.Index - Me.leftTop.Column.Index + 1 End Get End Property Public ReadOnly Property Height()Property Height() As Integer Get Return Me.rightBottom.RowIndex - Me.leftTop.RowIndex + 1 End Get End Property Public Sub New()Sub New(ByVal address As String) If address.IndexOf(":"c) > 0 Then Dim cells() As String = address.Split(":"c) Try leftTop = New CellWrapper(cells(0)) rightBottom = New CellWrapper(cells(1)) Catch ex As ArgumentException 'wide range selected: leftTop = Nothing rightBottom = Nothing Me.isWide = True End Try Else If address Like "$[A-Z,a-z]*$[1-9]*" Then leftTop = New CellWrapper(address) rightBottom = leftTop End If End If Me.addr = address End SubEnd Class最后是多个矩形区域组成的完整Range，我们用MultiRectRangeWrapper类来描述。它其实就是一个矩形区域的集合。
MultiRectRangeWrapperPublic Class MultiRectRangeWrapperClass MultiRectRangeWrapper Private rectRanges As List(Of RectRangeWrapper) Public ReadOnly Property Areas()Property Areas() As List(Of RectRangeWrapper) Get Return rectRanges End Get End Property Private ReadOnly addr As String Public ReadOnly Property Address()Property Address() As String Get Return addr End Get End Property Public Sub New()Sub New(ByVal address As String) addr = address rectRanges = New List(Of RectRangeWrapper) 'parse the ranges Dim numberOfRanges As Integer Dim rectRangeAddr As String() If addr.IndexOf(",") < 0 Then rectRangeAddr = New String(0) {addr} numberOfRanges = 1 Else rectRangeAddr = addr.Split(",") numberOfRanges = rectRangeAddr.Length End If For Each r As String In rectRangeAddr rectRanges.Add(New RectRangeWrapper(r)) Next End SubEnd Class好了，现在四个包装类已经全部写完了。用法就简单多了。用Range.Address属性初始化MultiRectRangeWrapper类，就可以得到一个该Range中所有矩形区域的集合，进而轻松访问该举行区域中每个单元格。比如下面这个例子，展示了一些简单的区域操作：
'取得用户选定的区域
Dim myrange As New MultiRectRangeWrapper(Application.Selection.Address)
For Each rectRange As RectRangeWrapper In myrange.Areas
If Not rectRange.IsWideRange Then
'非扩展选择的区域，比如整行或整列
'修改左上角的数字格式
Me.Range(rectRange.LeftTopCell.Address).NumberFormat = "0.00"
'将最后一个选中区域复制到剪贴版
Me.Range(rectRange.Address).Cut()
End If
Next
Dim myrange As New MultiRectRangeWrapper(Application.Selection.Address)
For Each rectRange As RectRangeWrapper In myrange.Areas
If Not rectRange.IsWideRange Then
'非扩展选择的区域，比如整行或整列
'修改左上角的数字格式
Me.Range(rectRange.LeftTopCell.Address).NumberFormat = "0.00"
'将最后一个选中区域复制到剪贴版
Me.Range(rectRange.Address).Cut()
End If
Next
我写这个只是为了我自己写程序方便，并没有考虑太多因素，所以可能写得比较粗糙，功能有限。有兴趣的可以在我这程序的基础上继续改进。
打印 | 张贴于 2006-03-23 11:49:00 | Tag:技术随笔
留言反馈
微软应该不太愿意让你这么做。。
刚才有问题，现在好了。。