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 в приведенном выше примере) в журнал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