提示文件打开，进行更改并另存为另一个副本，然后关闭+取消保存原始文件

Posted 2023-05-07

【中文标题】提示文件打开，进行更改并另存为另一个副本，然后关闭+取消保存原始文件

【英文标题】：Prompt file open, make changes and save as another copy, and close + unsave the original file

【发布时间】：2018-04-25 10:05:40

【问题描述】：

我正在尝试提示用户打开文件 1 和文件 2。 然后在文件 2 上进行更改（突出显示非日期单元格） 然后保存更改文件的副本2。 同时保持原文件2不保存并关闭。

下面是我的代码 运行结果：

file1 保持打开状态，

file2 高亮显示，但没有保存副本，它保持打开状态

请指教有什么问题。

 Sub LogSAVEAS()

 'prompt open file 1
 N = Application.GetOpenFilename _
 (Title:="Please choose file1", _
 FileFilter:="Excel Files *.xls*; *.csv (*.xls*; *.csv),")
Set twb = Workbooks.Open(N)

If N = False Then
MsgBox "No file selected. Please click run again and select file", 
vbExclamation, "Sorry!"
Exit Sub
Else
End If

'prompt open file 2
R = Application.GetOpenFilename _
(Title:="Please choose file2", _
FileFilter:="Excel Files *.xls*; *.csv (*.xls*; *.csv),")
Set extwbk = Workbooks.Open(R)
If R = False Then
MsgBox "No file selected. Please click run again and select file.", 
vbExclamation, "Sorry!"
Exit Sub
Else
End If


Dim WS As Worksheet

For Each WS In extwbk.workseets 'highlight issue format cell in file2
Call highlightdate(WS)

Next


Set extwbk = ActiveWorkbook
ActiveWorkbook.Sheets.copy 'copy file2 with highlight and save as "log"
dt = Format(CStr(Now), "yyyymmddhhmm")
ActiveWorkbook.SAVEAS Filename:=extwbk.Path & "\log" & dt & ".xlsx"

ActiveWorkbook.Close savechanges:=True 'save and close log

extwbk.Close savechanges:=False 'unsave and close file2

twb.Close savechanges:=True 'save and close file1


End Sub

Sub highlightnondate(WS As Worksheet)

With WS
  Set t = .Rows(1).Find("Date", lookat:=xlPart)

   If t Is Nothing Then Exit Sub

  For Each currentCell In Intersect(.Columns(t.Column), .UsedRange.Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count).Offset(1, 0))
        If Not IsEmpty(currentCell) And Not IsDate(currentCell.Value) Then counter = counter + 1
     If Not IsEmpty(currentCell) And Not IsDate(currentCell.Value) Then currentCell.Interior.color = 56231
   Next currentCell

   End With


End Sub

【参考方案1】：

我不确定，但问题可能是您先关闭了 ActiveWorkbook？