Private Sub Excel_Exchange()
'#先拷贝Excel
Set xlapp = CreateObject("Excel.Application") '创建EXCEL对象
file = txtDirectory.Text
Set xlbook = xlapp.Workbooks.Open(file) '打开已经存在的EXCEL工件簿文件
xlapp.Visible = False '设置EXCEL对象可见(或不可见)
Set xlsheet = xlbook.Worksheets(1) '设置活动工作表
xlsheet.Activate ''設定工作表為焦點
'xlSheet.Cells(Row, col) = 值 '给单元格(row,col)赋值
'xlSheet.PrintOut '打印工作表
On Error GoTo ErrHandler
file = Replace(file, ".xls", "_new.xls")
xlsheet.SaveAs file 'App.Path & "\test.xls" '按指定文件名存盘
'statusTxt.Caption = "转换完成.新文件为:" & file
xlapp.Quit '结束EXCEL对象'xlapp.Workbooks.Close
Set xlapp = Nothing '释放xlApp对象
'xlappTarget.Quit '结束EXCEL对象'xlapp.Workbooks.Close
'Set xlappTarget = Nothing '释放xlApp对象
'#拷贝Excel完成,在新的Excel中做处理#
'#打开拷贝的文件#
Set xlapp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlbook = xlapp.Workbooks.Open(file) '打开已经存在的EXCEL工件簿文件
xlapp.Visible = False '设置EXCEL对象可见(或不可见)
Set xlsheet = xlbook.Worksheets(1) '设置活动工作表
xlsheet.Activate ''設定工作表為焦點
Dim DataRange As Variant
Dim Irow As Long
Dim Icol As Integer
Dim MaxCols As Long
Dim status As String
Dim errStatus As String
Dim tim As Date
Dim hh As Date
DataRange = Range("A1").CurrentRegion.Value '不使用Set
MaxRows = Range("A1").CurrentRegion.Rows.count
'MaxCols = Range("A1").CurrentRegion.Columns.Count
Dim count As Integer
For Irow = 2 To MaxRows
tim = DataRange(Irow, 4)
' Debug.Print tim
' status = DataRange(Irow, 6)
errStatus = DataRange(Irow, 7)
' Debug.Print errStatus
hh = Format(tim, "HH:mm:ss")
If hh > "19:00" And hh < "23:59:59" Then
If InStr(errStatus, "无效记录") > 0 Or InStr("无效记录", errStatus) Then
'status = "加班签到"
''errStatus = "自由加班"
t = Format(tim, "MM\/dd\/yyyy HH:mm")
DataRange(Irow, 4) = t
DataRange(Irow, 6) = "加班签到"
DataRange(Irow, 7) = "自由加班"
' Debug.Print "----19:00~23:59"
count = count + 1
End If
End If
If hh > "00:00" And hh < "06:30" Then
If InStr(errStatus, "无效记录") > 0 Or InStr("无效记录", errStatus) Then
'status = "加班签退"
' errStatus = "自由加班"
t = Format(tim, "MM\/dd\/yyyy HH:mm")
DataRange(Irow, 4) = t
DataRange(Irow, 6) = "加班签退"
DataRange(Irow, 7) = "自由加班"
' Debug.Print "--------00~0630"
count = count + 1
End If
End If
Next Irow
Range("A1").CurrentRegion = DataRange '将结果写回到区域中
statusTxt.Caption = "转换完成,修改" & count & "条记录。" & vbCrLf & "新文件为:" & file
xlapp.DisplayAlerts = False '不提示保存
xlapp.Save
xlapp.Quit '结束EXCEL对象'xlapp.Workbooks.Close
Set xlapp = Nothing '释放xlApp对象
ErrHandler:
Debug.Print "修改记录:" & count
Debug.Print "退出," & "修改记录:" & count & " " & Now()
'用户按“取消”按钮。
Exit Sub
End Sub
Private Sub exchangeButton_Click()
If StrComp(txtDirectory.Text, "") = 0 Then
MsgBox "请选择要转换的Excel文件"
Else
exchangeButton.Enabled = False
statusTxt.Visible = True
statusTxt.Caption = "转换中,请稍候..."
Excel_Exchange
'statusTxt.Caption = "转换完成."
exchangeButton.Enabled = True
End If
End Sub
Private Sub openButton_Click()
'CancelError 为 True。
On Error GoTo ErrHandler
'设置过滤器。
CommonDialog1.Filter = "All Files (*.*)|*.*|Excel (*.xls)|*.xls"
'指定缺省过滤器。
CommonDialog1.FilterIndex = 2
'显示“打开”对话框。
CommonDialog1.ShowOpen
txtDirectory.Text = CommonDialog1.FileName
'调用打开文件的过程。
' OpenFile (CommonDialog1.FileName)
ErrHandler:
'用户按“取消”按钮。
Exit Sub
End Sub
注意客户端机器要注册:COMDLG32.OCX
拷贝 COMDLG32.OCX 到 c:\Windows\system32
运行命令注册
Regsvr32 COMDLG32.OCX
直接使用for循环操作,非常非常慢。现在这种处理方式,几秒钟可以处理完,用 For需要几分钟的时间
分享到:
相关推荐
VB操作EXCEL VB操作EXCEL VB操作EXCEL VB操作EXCEL
用VB操作excel方法汇总
vb操作excelvb操作excelvb操作excelvb操作excel
用VB操作Excel(VB6.0)
VB操作EXCEL大全,已经过测试 含VB操作EXCEL示例代码
vb操作EXCEL表的常用方法
vb操作Excel示例[UsingExcel.rar]-精品源代码
VB操作Excel实现读取写入打印标签工具代码
VB操作EXCEL技巧 源代码.rar VB和Excel的连接.rar 根据数据库生成Excel vb开发的读写word文档.rar 一个EXE程序,看了看好像只能生成Word 希望大家喜欢,今天做项目需要做这些,所以从CSDN上下载了一些相关资源,...
vb操作excel教程,很全面,vb开发人员必备。
用VB操作Excel 首先创建Excel对象,使用ComObj: Dim ExcelID as Excel.Application Set ExcelID as new Excel.Application 1)显示当前窗口: ExcelID.Visible:=True; 2)更改Excel标题栏: ExcelID.Caption:='...
vb 操作Excel资料
VB 操作EXCEL的示例程序,界面虽然简单但是基本涉及到了常见的操作
利用VB操作EXCEL来生成复杂的报表 vb操作EXCEL文件_编程技术收藏
VB操作EXCEL文件。非常不错的资源,推荐给大家使用,借此生成标准报告。满足办公、生活、进销管理及工业控制使用
vb 操作excel文档 函数很全 很实用 vb 操作excel文档 函数很全