Я пытаюсь предложить пользователю открыть файл1 и файл 2.
затем внесите изменения (выделите ячейку без даты) в файле 2
и затем сохраните копию измененного файла2.
В то же время сохраните исходный файл 2 и сохраните его.
Ниже мой код
Результат выполнения:
файл1 остается открытым,
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