Excel VBA刷新打開的文檔為只讀

Question

是否可以刷新以只讀方式打開的文檔，以便如果其他人可以打開以進行寫入，則該文檔可以顯示自上次刷新以來所做的任何更新，但不會偏離活動工作表？

我已經完成了前者，但是當它重新打開時，它將轉到上一次保存之前打開的工作表。

Sub refresh()
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & "name.xls", ReadOnly:=True
End Sub

謝謝

Answer 1

此代碼分為兩本工作簿

1. 它使用SheetActivate事件將主文件的當前工作表（在上面的示例中為SheetActivate連續寫入日志到log.txt文件中
2. “控制器”工作簿用於：
   • 測試主文件是否打開，
   • 如果是，則打開一個只讀版本（如果未正常打開實際文件），並且
   • 訪問文件日志（逐步存儲最后一張工作表，Windows登錄名和當前時間-可能過大） ，以設置最新工作表。

注意：
1.我只能在本地計算機上通過在主文件上運行兩個單獨的Excel實例來對此進行測試，因為Excel不會讓同一文件在同一實例中打開兩次）
2.我建議不要使用控制器工作簿，而是建議使用從桌面快捷方式執行的vbscript

更改此行以設置文件路徑和名稱以測試打開狀態
StrFileName = "c:\\temp\\main.xlsm"

Code for document to be opened: ThisWorkbook module

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Open ThisWorkbook.Path & "\log.txt" For Append As #1
    Print #1, Sh.Name & ";" & Environ("username") & ":" & Format(Now(), "dd-mmm-yy hh:mm")
    Close #1
End Sub

Code for Controller workbook: Normal module

我已經更新了Microsoft網站代碼以測試StrFileName是否已打開。 如果已打開，則將只讀版本打開到最新頁面

Sub TestFileOpened()
    Dim Wb As Workbook
    Dim StrFileName As String
    Dim objFSO As Object
    Dim objTF As Object
    Dim strLogTxt As String
    Dim arrStr

    StrFileName = "c:\temp\main.xlsm"
    If Dir(StrFileName) = vbNullString Then
        MsgBox StrFileName & " does not exist", vbCritical
        Exit Sub
    End If
    If IsFileOpen(StrFileName) Then
        Set Wb = Workbooks.Open(StrFileName, , True)
        If Dir(Wb.Path & "\log.txt") <> vbNullString Then
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objTF = objFSO.OpenTextFile(Wb.Path & "\log.txt", 1)
            Do Until objTF.AtEndOfStream
                strLogTxt = objTF.ReadLine
            Loop
            objTF.Close
            arrStr = Split(strLogTxt, ";")
            On Error Resume Next
            If Not IsEmpty(arrStr) Then
                Wb.Sheets(arrStr(0)).Activate
                If Err.Number <> 0 Then MsgBox arrStr(0) & " could not be activate"
            End If
            On Error GoTo 0
        End If
    Else
        Set Wb = Workbooks.Open(StrFileName)
    End If
End Sub

' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer
    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
    ' Check to see which error occurred.
    Select Case errnum
        ' No error occurred.
        ' File is NOT already open by another user.
    Case 0
        IsFileOpen = False
        ' Error number for "Permission Denied."
        ' File is already opened by another user.
    Case 70
        IsFileOpen = True
        ' Another error occurred.
    Case Else
        Error errnum
    End Select
End Function