vba之小功能记录--数据另存

编码环境： office2010
背景环境：合同控制部实现简单的数据复制。
程序代码:

Private Sub 另存为_Click()
Application.DisplayAlerts = False
Dim wb As Workbook
Dim idate As String
''''''''''''获取系统时间''''''''''''
idate = Date
''''''''''''弹出输入框 ''''''''''''
sr = Application.InputBox("请输入要保存的文件名", "输入提示")
''''''''''''添加新的excel文件 ''''''''''''
Set wb = Workbooks.Add
''''''''''''文件保存在当前目录下，以输入的文字命名''''''''''''
wb.SaveAs ThisWorkbook.Path & "/" & sr & ".xls"
ThisWorkbook.Sheets(" 表1").Range("a:t").copy wb.Sheets("sheet1").Range("a:t")
ActiveSheet.Name = " 表1"
wb.Sheets(" 表1").Range("P2").Value = idate
Columns("P:P").ColumnWidth = 15.25
ActiveWindow.Zoom = 80
wb.Save
i = 0
Do
    i = i + 1
    If Range("a" & i) = "合计" Then
    num = i - 1
    Exit Do
    End If
Loop
ThisWorkbook.Worksheets(" 表1").Range("a4:p" & num).ClearContents
ThisWorkbook.Save
wb.Save
Application.DisplayAlerts = True
End Sub

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/29987527/viewspace-1311757/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/29987527/viewspace-1311757/