Question

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

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

file1保持打开状态，

文件2突出显示但没有保存副本，并且保持打开状态

请告知它有什么问题。

 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

Answer 1

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

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

1 个答案: