Excel VBA刷新以只读方式打开的文档

Question

是否可以刷新以只读方式打开的文档，以便如果其他人将其打开以进行写入，它会显示自上次刷新以来所做的所有更新，但不会偏离事件工作表？

我已经完成了前者，但是当它重新打开时，它会转到上次保存之前打开的任何工作表。

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

谢谢

Answer 1

此代码进入两个工作簿

1. 它使用 SheetActivate 事件持续写入日志 主文件的当前工作表(上面示例中的 name.xls) log.txt 文件
2. “ Controller ”工作簿用于:
   • 测试主文件是否打开，
   • 如果是，则打开只读版本(如果不是，则正常打开实际文件)，并且
   • 访问文件日志(逐渐存储最后一个工作表、Windows 登录名和当前时间 - 可能有点过分) 来设置最新的工作表。

注意:
1.我只能通过在主文件上运行两个单独的 Excel 实例来在本地计算机上进行测试，因为 Excel 不会让同一个文件在同一实例中打开两次)
2. 我建议使用 vbscript 而不是 Controller 工作簿从桌面快捷方式执行

更改此行以设置要测试打开的文件路径和名称
StrFileName = "c:\temp\main.xlsm"

要打开的文档的代码:ThisWorkbook 模块

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

Controller 工作簿代码:普通模块

我已更新 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