提示用户打开工作簿并另存为新工作簿

Posted 2023-05-07

【中文标题】提示用户打开工作簿并另存为新工作簿

【英文标题】：prompt user open a workbook and save as a new workbook

【发布时间】：2018-04-25 03:22:31

【问题描述】：

尝试提示用户打开工作簿，然后在用户打开工作簿的同一路径下对其进行更改并另存为新工作簿。同时，保持用户打开工作簿不保存/不更改并关闭它。

以下是我的代码，但失败 - 新工作簿为空，用户打开的工作簿未关闭。

Sub saveas()

R = Application.GetOpenFilename _
(Title:="Please choose file", _
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

'a = extwbk.Worksheets.Count
'For i = 1 To a
'will input code there that make change on the open workbook 
'Next i
'After change process complete,  save the changed workbook as a new workbook in the 
same path of the  openworkbook and then keep the origin openworkbook 
unchange and then close it



Set extwbk = ActiveWorkbook
ActiveWorkbook.Sheets.Copy
ActiveWorkbook.saveas Filename:=extwbk.Path & "\log.xlsx"
   ActiveWorkbook.Close savechanges:=True
extwbk.Close savechanges:=False


End Sub

【参考方案1】：

我认为你需要从

更改你的最后一行

ActiveWorkbook.Close savechanges:=False

到

ActiveWorkbook.Close savechanges:=True
extwbk.Close savechanges:=False

否则我认为当您使用 ActiveWorkbook.saveas 保存新工作簿时 - 它会立即成为活动工作簿

【讨论】：

感谢它现在可以工作，您的建议和 workbook.Add--> ActiveWorkbook.Sheets.Copy