vb读取一个excel的数据,然后复制到另一个excel2里,并把excel2的名称按照时间保存。具体,见补充
vb读取E:\REPORT.XLS里的数据,然后把里面的数据全部复制到另一个目录下自动生成excel文件并以日期+时间命名的excel里。因为我的report.XLS里的...
vb读取E:\REPORT.XLS里的数据,然后把里面的数据全部复制到另一个目录下自动生成excel文件并以日期+时间命名的excel里。因为我的report.XLS里的数据是你打开时就自动更新数据(自动读取数据库)所以不能直接保存,不然每次打开他都自动更新到你打开时间的数据了,我要每隔1个小时保存一次,所以想用vb写个东西,让他把数据复制出来到另一个新建excel里,并按照日期+时间保存excel表,格式大概就是如图
图中生成报表时间是保存报表的时间,也要写进去, 展开
图中生成报表时间是保存报表的时间,也要写进去, 展开
展开全部
on error resume next
'开启错误捕捉,出现错误,进入下一行
dim myapp as object
dim wk1 as object,wk2 as object
set myapp=CreateObject("Excel.Application")
myapp.enableevents=false
'取消EXCEL程序响应事件
myapp.calculation=-4135
'取消公式自动更新
myapp.visible=false
‘取消EXCEL程序显示
set wk1=myapp.workbooks.open("E:\REPORT.XLS",,1)
'只读打开对应的表格
if wk1 is nothing then
msgbox "打开工作表出现错误!" & chr(10) & err.description
exit sub
'如果打开工作薄错误,则退出程序
endif
err.clear
set wk2=myapp.workbooks.add
’新增空白工作薄
wk1.sheets("sheet1").cells.copy
’复制内容
wk2.sheets("sheet1").range("a1").PasteSpecial -4163 'xlpastevalues
'首先先粘贴数据内容
wk2.sheets("sheet1").range("a1").PasteSpecia -4122 ' xlpasteformats
‘再粘贴单元格格式
wk2.saveas "D:\" & format(now(),"YYYYMMDDHH") & ".xls"
’保存工作表
wk2.close 0
wk1.close 0
set wk2=nothing
set wk1=nothing
set myapp=nothing
'关闭工作薄,释放对象
'开启错误捕捉,出现错误,进入下一行
dim myapp as object
dim wk1 as object,wk2 as object
set myapp=CreateObject("Excel.Application")
myapp.enableevents=false
'取消EXCEL程序响应事件
myapp.calculation=-4135
'取消公式自动更新
myapp.visible=false
‘取消EXCEL程序显示
set wk1=myapp.workbooks.open("E:\REPORT.XLS",,1)
'只读打开对应的表格
if wk1 is nothing then
msgbox "打开工作表出现错误!" & chr(10) & err.description
exit sub
'如果打开工作薄错误,则退出程序
endif
err.clear
set wk2=myapp.workbooks.add
’新增空白工作薄
wk1.sheets("sheet1").cells.copy
’复制内容
wk2.sheets("sheet1").range("a1").PasteSpecial -4163 'xlpastevalues
'首先先粘贴数据内容
wk2.sheets("sheet1").range("a1").PasteSpecia -4122 ' xlpasteformats
‘再粘贴单元格格式
wk2.saveas "D:\" & format(now(),"YYYYMMDDHH") & ".xls"
’保存工作表
wk2.close 0
wk1.close 0
set wk2=nothing
set wk1=nothing
set myapp=nothing
'关闭工作薄,释放对象
展开全部
'首先要将“工程-引用”中的Mic… Excel…选中
Private Sub Command1_Click()
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application")
On Error Resume Next
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(App.Path & "\1.xls")
k = 5
Do While xlApp.Worksheets("Sheet1").Range("A1").Cells(k, 2) <> ""
xlApp.Worksheets("Sheet1").Range("A1").Cells(k, 3) = Format(Now, "yyyy-mm-dd")
xlApp.Worksheets("Sheet1").Range("A1").Cells(k, 4) = Format(Time, "hh:mm")
xlApp.Worksheets("Sheet1").Range("A1").Cells(k, 11) = Format(Now, "yyyy-mm-dd")
xlApp.Worksheets("Sheet1").Range("A1").Cells(k, 12) = Format(Time, "hh:mm")
k = k + 1
Loop
path1 = "C:\Documents and Settings\Administrator\桌面\"
name1 = Format(Now, "yyyymmddhhmmss") & ".xls"
ActiveWorkbook.SaveAs FileName:=path1 & name1
ActiveWorkbook.Close
xlBook.Close (True)
xlApp.Quit
Set xlApp = Nothing
End Sub
Private Sub Command1_Click()
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application")
On Error Resume Next
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(App.Path & "\1.xls")
k = 5
Do While xlApp.Worksheets("Sheet1").Range("A1").Cells(k, 2) <> ""
xlApp.Worksheets("Sheet1").Range("A1").Cells(k, 3) = Format(Now, "yyyy-mm-dd")
xlApp.Worksheets("Sheet1").Range("A1").Cells(k, 4) = Format(Time, "hh:mm")
xlApp.Worksheets("Sheet1").Range("A1").Cells(k, 11) = Format(Now, "yyyy-mm-dd")
xlApp.Worksheets("Sheet1").Range("A1").Cells(k, 12) = Format(Time, "hh:mm")
k = k + 1
Loop
path1 = "C:\Documents and Settings\Administrator\桌面\"
name1 = Format(Now, "yyyymmddhhmmss") & ".xls"
ActiveWorkbook.SaveAs FileName:=path1 & name1
ActiveWorkbook.Close
xlBook.Close (True)
xlApp.Quit
Set xlApp = Nothing
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
这个问题不是太难 网上有
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
I think you can just use file copy, it doesn't matter excel or not, then add date time for the new excel.
更多追问追答
追问
如果能够copy,我还问么,晕死,我打开源excel数据就会立刻更新为现在的数据,我要的是以前的数据,明白,,,!
追答
if it has macro to update the data, then disable it.
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询