'存檔前執行
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ofile, ff, readfile
Dim theShell As Object
'指定路徑和檔名
DataPath = "C:\XXXX\YYYYY\"
DataFile = "ZZZZZ.xls"
'確認是否有此檔案
With Application.FileSearch
.NewSearch
.LookIn = DataPath
.Filename = DataFile
If .Execute() > 0 Then ff = .FoundFiles.Count
End With
'如果有檔案則開啟此檔案，如果無則跳出 File 對話窗，選取檔案
If ff > 0 Then
' Open( 檔名 , 不做 Update link , 唯讀 )
Set ofile = Workbooks.Open( DataPath & DataFile , 0, True)
Else
'如果找不到檔案，開啟 File 對話窗選取檔案
MsgBox DataPath & DataFile & "檔案不存在，請重新選取路徑。"
Set readfile = Application.FileDialog(msoFileDialogFilePicker)
Dim v As Variant
With readfile
.Filters.Clear
.InitialFileName = DataPath
.InitialView = msoFileDialogViewDetails
.Filters.Add "All Excel Files", "*.xls"
.AllowMultiSelect = False
If .Show Then
v = .SelectedItems.Item(1)
End If
End With
'如果沒有選擇檔案直接結束。
If v Is Nothing Then
Set ofile = Workbooks.Open(v, 0, True)
Else
MsgBox "檔案不存在，請確認。"
End
End If
End If
Cells.Select
Selection.Copy
Dim ck, ckr As Boolean
ck = False
'確認本地檔案中是否有 Index sheet ，如果有需 Delete Index sheet
For Each element In Me.Worksheets
If element.Name = "Index" Then
' Disable 詢問
Application.DisplayAlerts = False
Me.Worksheets("Index").Delete
Application.DisplayAlerts = True
ck = True
Exit For
End If
Next
ck = False
'由來源檔插入 Index Fig sheet 於 Content sheet 之後，並將 Index Fig sheet 改名為 Index sheet
For Each element In ofile.Worksheets
If element.Name = "Index Fig" Then
ofile.Worksheets("Index Fig").Copy after:=Me.Worksheets("Content")
Me.Worksheets("Index Fig").Name = "Index"
ck = True
Exit For
End If
Next
'如果 ck = False 表 來源檔無 Index Fig sheet
If ck = False Then
MsgBox "ZZZZZ.xls 中的 [ Index Fig ] sheet 不存在請確認"
ofile.Close (False)
End
End If
ofile.Close (False)
End Sub
