'事件
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ThisWorkbook.Name = "BB DDE.xls" Then Call 還原檔名VBA
End Sub
Private Sub Workbook_Open()
Call 修改檔名VBA
End Sub
'模組
Option Explicit
Sub 修改檔名VBA()
Dim newwk As Object
Dim newfname As String
Set newwk = ThisWorkbook
With newwk
newfname = .Path & "\" & .Name
If .Name = "AA DDE.xls" Then
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
.SaveCopyAs .Path & "\BB DDE.xls"
Workbooks.Open .Path & "\BB DDE.xls"
Workbooks("BB DDE.xls").Activate
.ChangeFileAccess xlReadOnly
Kill .FullName
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
.Close False
End If
End With
End Sub
Sub 還原檔名VBA()
Dim oldwk As Object
Dim oldfname As String
Set oldwk = ThisWorkbook
With oldwk
If .Name = "BB DDE.xls" Then
oldfname = .Path & "\" & .Name
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
.SaveCopyAs .Path & "\AA DDE.xls"
On Error Resume Next
.ChangeFileAccess xlReadOnly
Kill .FullName
On Error GoTo 0
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Application.Quit
End If
End With
End Sub