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/，如需转载，请注明出处，否则将追究法律责任。