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