VBA Excel无法在一张

时间:2017-11-02 23:16:20

标签: excel vba excel-vba excel-formula

三个宏。 StartSample模块按预期执行。 PivotCheck是我编写的一个自定义函数,可以在我的机器上运行,但是一旦文件被保存为另一个文件(这对于自定义函数来说并不罕见,所以我并不过分关注那个)。 FinishSample是让我疯狂的模块。时间戳应该是一个非常简单的事情,它可以在StartSample模块上运行。我无法弄清楚它不喜欢完成什么,代码中的其他所有内容似乎都按预期运行。

1)这是StartSample代码

Sub Start()
    ' Macro Purpose: Creates a new spreadsheet after applicant enters name and saves it with the applicant's initials as an identfier.

    ' Defines Variables.
    Dim TempFilePath As String
    Dim TempFileName As String

    ' Sets references.
    ' Creates a separate file on the desktop that is renamed with user's initials.
    TempFilePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
    TempFileName = Sheets("Results").Range("AppIn").Text & "MCDAII_Excel_Sample.xlsm"

    ' Optimizes macro performance.
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    ' Saves file as separate file with applicant's identifier as filename on the desktop.
    ActiveWorkbook.SaveAs TempFilePath & TempFileName

    ' Unhides the worksheets with questions and relevant information.
    Sheets("Q_One").Visible = True
    Sheets("Definitions").Visible = True
    Sheets("Data").Visible = True
    Sheets("Q_Two").Visible = True
    Sheets("Q_Bonus").Visible = True

    ' Timestamp.
    Sheets("Start").Range("M1Time") = Now()
    Sheets("Start").Range("M1Time").Copy
    Sheets("Start").Range("M1Time").PasteSpecial xlPasteValues
    Sheets("Results").Visible = xlVeryHidden

    ' Saves changes and activates the Q_One tab for applicant to start sample.
    ActiveWorkbook.Save
    Worksheets("Q_One").Activate
    Range("A1").Activate

    ' Returns operations to normal.
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With


End Sub

2)这是FinishSample代码

Sub Finish()

    ' Macro Purpose: Saves applicant's sample to be reviewed later.

    ' Defines Variables.
    Dim sh As Worksheet

    ' Optimizes macro performance.
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    ' Gives user one last chance to review work or continues to save sample for review.
    MsgBoxResult = MsgBox("Clicking OK will close the spreadsheet and lock you out of the sample." & vbCrLf _
                        & "If you would like to continue working, please click Cancel.", vbOKCancel, "Final Notice")

    If MsgBoxResult = vbCancel Then
        Exit Sub
    ElseIf MsgBoxResult = vbYes Then

        ' Timestamp. <===PROBLEM: The next three lines of code don't function, even though they are identical to the StartSample module.
        Sheets("Start").Range("M2Time") = Now()
        Sheets("Start").Range("M2Time").Copy
        Sheets("Start").Range("M2Time").PasteSpecial xlPasteValues 

        ' Unhides each sheet in the workbook (I thought), but it doesn't appear to affect xlVeryHidden.
        On Error Resume Next
        For Each sh In Worksheets
            sh.Visible = xlSheetVisible
        Next

    End If

    ' Returns operations to normal.
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    ' Password protects, saves, then closes workbook.
    ActiveWorkbook.Password = "Milk"
    ActiveWorkbook.Save
    Application.Quit

End Sub

1 个答案:

答案 0 :(得分:1)

您正在使用vbOKCancel代替MsgBox按钮,然后检查

 MsgBoxResult = vbYes 

它只会是vbOK或vbCancel