背景环境:合同控制部实现简单的数据复制。
程序代码:
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