暂停excel VBA,直到用户保存文件副本

时间:2015-10-24 13:41:50

标签: excel-vba vba excel

在用户保存Excel附件之前暂停VBA的正确语法是什么?在下面的VB中,在打开工作簿时会提示用户选择,如果选择为是,则会出现另一个消息框,要求他们填写表单并保存。我试图暂停VB直到点击保存。但是,我目前收到很多编译错误。添加了** **的行以尝试完成此操作,谢谢你:)。

VB

Private Sub Workbook_Open()
Dim WS As Worksheet, Rng As Range, c As Range
Dim OutApp As Object, OutMail As Object
Dim Msg As String, Addr As String, FName As String, i As Long
Dim obj As Object
**Dim MyDoc As Document**
Dim MyFileCopy As String
Dim intAnswer As Integer

'define path
 MyFileCopy = "L:\NGS\HLA LAB\total quality management\QC & QA\DOSE reports\DOSE reporting form Attachment.xlsx"

'open sheet
 Sheets("Email").Activate
 intAnswer = MsgBox("Are there any issues to report", vbYesNoCancel)
  Select Case intAnswer
  Case vbYes
  Range("D2").Value = "x"
  MsgBox ("Please select an issue and save"), vbExclamation

  'create a separate sheet2 to mail out and pause VB
   Sheets(2).Copy
   Set wkb = ActiveWorkbook
   With wkb
   **Set MyDoc = Documents.Add
   MyDoc.SaveAs "MyFileCopy.xlsx"
   DoEvents
   Do
   Loop Until MyDoc.Saved
     .Close True**
   End With

  Case vbCancel
  Application.SendKeys "%{F11}", True

  Case Else
  Range("C2").Value = "x"
  End Select

'create connection, check condition, send email
 Set OutApp = CreateObject("Outlook.Application")
 Set WS = ThisWorkbook.Sheets("Email")
With WS
 Set Rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With

 For Each c In Rng

 Msg = "For " & WS.Cells(2, 2) & Chr(14) & Chr(14)
 For i = 3 To 4
 If LCase(WS.Cells(2, i)) = "x" Then
    Msg = Msg & "   -" & WS.Cells(1, i) & Chr(14)
 End If
Next

    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = c
        .CC = ""
        .BCC = ""
        .Subject = "Daily Operational Safety Briefing"
        .Body = Msg
        If Range("D2").Value & Chr(14) = "x" Then .Attachments.Add MyFileCopy, 1
        .Send
    End With
Next c

Set OutMail = Nothing
Set OutApp = Nothing

'confirm message sent, clear sheet, and delete copy
 MsgBox "The data has been emailed sucessfully.", vbInformation
 Range("C2:D2").ClearContents
 Kill MyFileCopy


'Exit and do not save
 Application.Quit
 ThisWorkbook.Close SaveChanges:=False
 End Sub

0 个答案:

没有答案