点击按钮将EXCEL另存为

刘玉蓉发布于2014-10-10 16:53 370 0 标签：

现在在画面上做两个按钮，一个是打开事先做好的文件范本
Sub OnLButtonDown(ByVal Item, ByVal Flags, ByVal x, ByVal y)
Dim objExcelAPP
Set objExcelAPP=CreateObject("Excel.Application")
objExcelAPP.Visible=True
objExcelAPP.Workbooks.Open "D:生产记录报表.xls"
End Sub
而另一个的功能是，当操作人员将excel文件中的内容填写完毕后，鼠标点击这个按钮，文件按照点击按钮的时间（年、月、日、时、分、秒）来将文件在同意文件夹下（即生产记录文件夹中）另存为新的EXCEL文件，同时关闭之前打开的范本，这样每天都利用同一范本可生成新的文件，这个按钮的功能我实在不会，望指教一下

佳答案

On Error Resume Next ""此句必须有，防止无EXCEL进程时GetObject出错退出
Dim objExcelAPP,xlbook,xlsname,isOpen
xlsname="D:生产记录报表.xls"                      ""Excel文档路径
   Set objExcelAPP=GetObject(,"Excel.Application") ""获取当前运行的Excel应用程序对象
   objExcelAPP.Visible=True

If Typename(objExcelAPP)="Application" Then     ""Excel已打开，遍历工作薄查找对应文档是否已打开
    For Each xlbook In objExcelAPP.Workbooks
        If xlbook.FullName=xlsname Then
           isOpen=True
           Exit for
        End if
    Next
End if

If isOpen Then
    xlbook.SaveAs "D:生产记录" & Date & "_" & Hour(Now) & "_" & Minute(Now) & "_" & Second(Now) & ".xls"
Else
    Msgbox "文件没有打开!"
End if

objExcelAPP.Quit
Set objExcelAPP = Nothing