VB操作EXCEL

一.设置excel对象，strDestPath是EXCEL数据源位置。
Private Function prepareExcel(ByVal strDestPath As String)
Set exlApp = CreateObject("Excel.Application")
Set book = exlApp.Workbooks.Open(strDestPath)

End Function

二.操作EXCEL中的行列。

1.行列的改变，strCell需要改变的单元格，intRowOffset行改变的数量，intColOffset列改变的数量，返回值为改变后的单元格。
Public Function changeRowColumn(ByVal strCell As String, ByVal intRowOffset As Integer, ByVal intColOffset As Integer) As String

Dim intRow, intCol As Integer
Dim strCell_Changed As String
intCol = Asc(Left$(strCell, 1)) + intColOffset
intRow = Mid$(strCell, 2) + intRowOffset
strCell_Changed = Chr$(intCol) & intRow
changeRowColumn = strCell_Changed

End Function

比如：strNewCell = changeRowColumn("A1", 1,2)返回的单元格为B3。

2.复制给定的范围，strStartCell开始单元格，strEndCell结束单元格，intDestRow需要插入的目标行位置,intRowNum共需要插入的行数。

Public Function copyRange(ByVal strStartCell As String, ByVal strEndCell As String, ByVal intDestRow As Integer, sheet As Excel.Worksheet, ByVal intRowNum As Integer) As Integer

Dim intEndRow As Integer
Dim strCell As String
strCell = strStartCell
Range(strStartCell, strEndCell).Copy
If intRowNum > 0 Then
For i = intDestRow To intRowNum + intDestRow
strCell = changeRowColumn(strCell, 1, 0)
Range(strCell).Select
ActiveSheet.Paste
Next i
End If
intEndRow = i
copyRange = intEndRow

End Function
3.行浮动转换成行列固定。

Public Function changeTableRowFixed(sheet As Excel.Worksheet, ByVal rowNum As Integer, intStartRow As Integer)
Dim intRow As Integer
'如果是行浮动的报表
If blnRowFix = False Then
'获取数据区的第一行
intRow = intStartRow
'先复制数据区的第一行
sheet.Rows(intRow & ":" & intRow).Copy
'然后循环插入，把表格转化成行列固定的
If rowNum <> 1 Then
For i = intRow + 1 To rowNum + intRow - 1
sheet.Rows(i & ":" & i).PasteSpecial
Next i
End If
End If
End Function

4.填充给定范围，1个数据源填充2个不相邻的范围。

Public Function fillRange_2(strStartCell_1 As String, strEndCell_1 As String, strStartCell_2 As String, strEndCell_2 As String, RS As ADODB.Recordset, sheet As Excel.Worksheet)

If RS.RecordCount > 0 Then
RS.MoveFirst
'重新定义数组
ReDim arrData(0 To RS.RecordCount - 1, 0)
ReDim arr(0 To RS.RecordCount - 1, 0)
For i = 0 To RS.RecordCount - 1
For j = 1 To RS.Fields.Count - 1
Select Case j:'将数据源RS中的索引为1和2的数据列填入表格

Case 1: arrData(i, 0) = RS.Fields(j).Value
Case 2: arr(i, 0) = RS.Fields(j).Value
End Select
Next j
RS.MoveNext
Next i
'填充excel给定的范围
sheet.Range(strStartCell_1, strEndCell_1) = arrData
sheet.Range(strStartCell_2, strEndCell_2) = arr
End If

End Function

5.删除多余的单元格,同时下方的单元格上移

Public Function deleteExtraCell(intLastCol As Integer, intFirstRow As Integer, intFirstCol As Integer)

Dim strBeginCell, strEndCell As String
strBeginCell = Chr$(intFirstCol) & intFirstRow
strEndCell = Chr$(intLastCol) & 199
Range(strBeginCell, strEndCell).Delete Shift:=xlUp
End Function

三.EXCEL保存及资源释放设置。

'显示excel
exlApp.Visible = True
exlApp.WindowState = xlMaximized

'将sheet1设为活动工作簿
exlApp.Worksheets(1).Activate
'将sheet1的第一行第一列单元格设为活动单元格
exlApp.ActiveSheet.Cells(1, 1).Activate

'清除剪贴板上的内容
Clipboard.Clear

'关闭excel时不弹出是否保存的窗口
exlApp.ActiveWorkbook.Saved = False
exlApp.DisplayAlerts = False

'保存
book.SaveAs FileName

'释放excel资源
Set sheet = Nothing
Set book = Nothing
Set exlApp = Nothing