Question

我正在创建一个命令按钮宏，它接受具有按钮的工作表（只有工作簿中的一个），创建副本，用值替换公式，并保存工作表的两个副本。我尝试使用我在其他地方找到的代码，但是当宏到达SaveAs行时，它会出错。

这大部分来自我之前提出的问题，但我无法弄清楚我没有看到或搞砸了什么。提前谢谢。

Private Sub SaveAuth1_Click()
'   Saves the Authorization in the Current Year's Pay Estimate Folder in
'   Dave's Snapserver Construction Files
'   Then clears the form, hides the form, and quits Excel.

Dim AFName As String   'this will be the name of the new file name saved in the Pay Estimates Folder
Dim AFfolder As String 'This is the folder to save the form into
Dim AFDate As String   'This is the date to choose which year's folder to use
Dim afile As String     ' This is the full file name to be saved.
Dim ws As Worksheet
    Set ws = Worksheets("BLR 13210")

If ws.Range("E15") = "" Then
    ans = MsgBox("This form is not ready to be saved", vbOKOnly, "BLR 13210")
    Select Case ans
        Case vbOK
        Exit Sub
    End Select
End If

'**** TRIAL is added here until project is compelted.
AFName = "TRIAL" & Worksheets("Initial Entry").Range("B5") & " " & "Authorization " & _
    ws.Range("G17") & " - " & ws.Range("E15")
ans = MsgBox(AFName, vbOKCancel)
Select Case ans
    Case vbCancel
        Exit Sub
    Case vbOK
        GoTo Line1
End Select

Line1:
' Saves a copy of the form into Daves Snapserver folders and then prompts the SaveAs dialog box
' to save a second copy in the user's files.

AFDate = Year(Now())
AFfolder = "M:\DotserverD\Daves Snapserver Files Construction Files\" & AFDate & " Pay Estimates"

Debug.Print AFfolder
Application.ScreenUpdating = False

' Creates new workbook
Set NewBook = Workbooks.Add
ThisWorkbook.Worksheets("BLR 13210").Copy Before:=NewBook.Sheets(1)
' Replaces the referenced formula values with the actual values (removes reference to other sheet)
With NewBook.Sheets("BLR 13210").UsedRange
    .Value = .Value
End With

' Deletes buttons from the bid tab worksheet being saved
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
    Shp.Delete
Next Shp

' removes warning about saving worksheet with macros as .xlsx format and possibly deleting data.
Application.DisplayAlerts = False
Application.EnableEvents = False

' Deletes unused worksheets
Worksheets("Sheet1").Delete
Worksheets("Sheet2").Delete
Worksheets("Sheet3").Delete

afile = AFfolder & "\" & AFName
Debug.Print afile
NewBook.SaveAs Filename:=afile, FileFormat:=xlOpenXMLWorkbook   '<---  Runtime error 1004 Application/object defined

Application.DisplayAlerts = True
Application.EnableEvents = True

Workbooks(AFName).Close (True)
Application.ScreenUpdating = True
Application.Dialogs(xlDialogSaveAs).Show

ans = MsgBox("Proceed?", vbOKCancel)
Select Case ans
    Case vbCancel
        Exit Sub
    Case vbOK
        GoTo Line2
End Select

Answer 1

我有一种感觉，您需要将延伸添加到此： AFName = "TRIAL" & Worksheets("Initial Entry").Range("B5") & " " & "Authorization " & _ ws.Range("G17") & " - " & ws.Range("E15")

afile = AFfolder & "\" & AFName & ".xlsx"

编辑：

在字符串AFname中识别出问题：

ws.range（＆＃34; E15＆＃34;）的日期格式为＆＃39; /＆＃39;字符。 excel无法以非法字符保存图书。将格式调整为用破折号格式化的日期。

NewBook.SaveAs期间的运行时1004应用程序定义或对象定义的错误

1 个答案: