Excel VBA 在儲存前捉取別 Excel 檔 sheet 作更新動作

'存檔前執行

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