Question

是否可以将文档刷新为只读，以便如果其他人将其打开以进行写入，则显示自上次刷新以来所做的任何更新但不会偏离活动工作表？

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

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

由于

Answer 1

此代码分为两个工作簿

它使用SheetActivate事件来连续写入日志主文件的当前表（上例中的name.xls）到一个log.txt文件
A＆＃34;控制器＆＃34;工作簿用于：
- 测试主文件是否打开，
- 如果是，则打开只读版本（如果没有正常打开实际文件），
- 访问文件日志（存储最后一页，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

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

1 个答案: