因工作册太大,都指定各自目录·为了方便,在表单里添加另保存并指定目录,可问题是,保存后的表单里无内容,请达人帮我看看哪里错了
Private Sub CommandButton4_Click()
Dim NowWorkbook As Workbook, wb As Workbook, Sht As Worksheet
Dim FileName As String, nm$, n&
On Error GoTo line
Set wb = ThisWorkbook
nm = Sheet1.[a1].Value
FileName = Application.GetSaveAsFilename _
(InitialFileName:="C:\Users\Administrator\Desktop\zuozuo27\00\02采购报告" & nm, _
fileFilter:="Excel files(*.xls),*.xls,All files (*.*),*.*")
If FileName <> "False" Then
Set NowWorkbook = Workbooks.Add
With NowWorkbook
.SaveAs FileName
n = 0
For Each Sht In wb.Sheets
n = n + 1
Sht.UsedRange = Sht.UsedRange.Value
Sht.UsedRange.Copy .Sheets(n).Range("A1")
For Each shp In .Sheets(n).Shapes
shp.Delete
Next
Next
.Save
End With
GoTo line
End If
Exit Sub
line:
ActiveWorkbook.Close
End Sub
Private Sub CommandButton4_Click()
Dim NowWorkbook As Workbook, wb As Workbook, Sht As Worksheet
Dim FileName As String, nm$, n&
On Error GoTo line
Set wb = ThisWorkbook
nm = Sheet1.[a1].Value
FileName = Application.GetSaveAsFilename _
(InitialFileName:="C:\Users\Administrator\Desktop\zuozuo27\00\02采购报告" & nm, _
fileFilter:="Excel files(*.xls),*.xls,All files (*.*),*.*")
If FileName <> "False" Then
Set NowWorkbook = Workbooks.Add
With NowWorkbook
.SaveAs FileName
n = 0
For Each Sht In wb.Sheets
n = n + 1
Sht.UsedRange = Sht.UsedRange.Value
Sht.UsedRange.Copy .Sheets(n).Range("A1")
For Each shp In .Sheets(n).Shapes
shp.Delete
Next
Next
.Save
End With
GoTo line
End If
Exit Sub
line:
ActiveWorkbook.Close
End Sub