Office中国论坛/Access中国论坛

标题: 请教，怎样才能按当天日期另存工作薄里的工作表？ [打印本页]

作者: lxq2005 时间: 2006-9-27 19:03
标题: 请教，怎样才能按当天日期另存工作薄里的工作表？
请教各位版主及大侠：

怎样才能按当天的日期另存工作薄内的工作表？

thanks

[此贴子已经被作者于2006-9-27 19:36:08编辑过]

作者: lxq2005 时间: 2006-9-28 00:07
下面是从书面摘录的一段代码,因学习还未到这,修改为只要其中一个表格改为当日日期并储存总是出错,请高手指教并简化代码:

Sub aa()

Dim ws As Worksheet

Application.DisplayStatusBar = True
Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Sheets
      Dim NewFileName As String

      Application.StatusBar = ThisWorkbook.Sheets.Count & "Remaining Sheets"


      If ThisWorkbook.Sheets.Count <> 1 Then

         Sheet1.Select
         Sheet1.Name = Range("E1").Value
         Sheet2.Select
         Sheet2.Name = Range("E1").Value
         Sheet3.Select
         Sheet3.Name = Range("E1").Value

         NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xls"

         ws.Copy

         ActiveWorkbook.Sheets(1).Name = Range("E1").Value
         ActiveWorkbook.SaveAs Filename:=NewFileName
         ActiveWorkbook.Close savechanges:=False
      Else
         NewFileName = ThisWorkbook.Path & "\" & ws.Name & ".xls"
         ws.Name = Range("E1").Value
         ThisWorkbook.SaveAs Filename:=NewFileName
      End If
Next

Application.StatusBar = False

Application.ScreenUpdating = True



End Sub

"E1"为当日日期,上述代码为将3个工作表名改为日期,并以日期另存为三个工作薄

                                                                                          thanks

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)