|
一.设置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,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 = NothingSet book = NothingSet exlApp = Nothing （编辑：李大同）
【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
|
