共享问题中的excel vba加载项

时间:2019-05-20 03:16:35

标签: excel vba sharepoint add-in

Public Sub loadReleaseNotes()
'--------------------------------------------------------------------------------------------
'Created by 1462155 on 25Jun13
'Comments: This will load the release notes from sharepoint at workbook open
'--------------------------------------------------------------------------------------------
On Error GoTo loadReleaseNotes_Error
Dim wks As Worksheet
Dim lRow As Long
Dim lstObj As ListObject

Dim sAppName As String

    Set wks = ThisWorkbook.Sheets("sys_ReleaseNotes")
    sAppName = getSysRngVal("sys_EucName")

'A. IF YOUR WORKBOOK CONTAINS PASSWORD PROTECTION MECHANISM, RUN THE UNLOCK WKS HERE
'--------------------------------------------------------------------------------------------
    'e.g. UnlockAllWks (Wks)
'--------------------------------------------------------------------------------------------

    'REFRESH THE LIST
    removeAllListObjects wks
    lRow = getNextRow(wks)
    linkSpList wks

    'UNLINK THE LISTOBJECT SO USER IS NOT PROMPTED BY EXCEL WHEN SAVING OR CLOSING THE WORKBOOK
    Set lstObj = wks.ListObjects(1)
    lstObj.Unlink
    lstObj.Range.AutoFilter Field:=2, Criteria1:="=" & sAppName

loadReleaseNotes_Exit:
'B. IF YOUR WORKBOOK CONTAINS PASSWORD PROTECTION MECHANISM, RUN THE LOCK WKS HERE
'--------------------------------------------------------------------------------------------
    'e.g. LockAllWks (Wks)
'--------------------------------------------------------------------------------------------
    Exit Sub

loadReleaseNotes_Error:
    g_bSysVerErr = True
    logSystem "loadReleaseNotes:" & Err.Description, Err.Number
    GoTo loadReleaseNotes_Exit

End Sub

Public Function latestVersion() As Double
'--------------------------------------------------------------------------------------------
'Created by 1462155 on 25Jun13
'Comments: Returns the latest registered version of the application from sharepoint
'--------------------------------------------------------------------------------------------
Dim dVer As Double
Dim wks As Worksheet
Dim wksS As Worksheet
Dim rngApp As Range

    Set wks = ThisWorkbook.Sheets("sys_ReleaseNotes")
    Set wksS = ThisWorkbook.Sheets("sys_Settings")
    Set rngApp = wksS.Range("sys_EucName").Offset(-1, 0).Resize(2, 1)

    dVer = Application.WorksheetFunction.DMax(wks.ListObjects(1).Range, "VersionNo", rngApp)

    latestVersion = dVer

End Function

Public Sub validateVersion()
'--------------------------------------------------------------------------------------------
'Created by 1462155 on 25Jun13
'Comments:  Validates if worksheet is the latest version of the app.
'           Prompts the users if they are using an older version
'--------------------------------------------------------------------------------------------
Dim dVer As Double
Dim dLocVer As Double

    dVer = latestVersion
    dLocVer = getSysRngVal("sys_EucVersion")

    If dVer = 0 Then
       MsgBox " This is an unregistered version, please contact EUC Team to get it registered ", vbCritical

    ElseIf dVer > dLocVer Then
        MsgBox "You are using an old version of the workbook " & vbNewLine & _
                "The latest version is " & Format(dVer, "0.00") & vbNewLine & vbNewLine & _
                "Please refer to the release notes and update to the latest version.", vbCritical

    ElseIf dVer < dLocVer Then
        MsgBox "You are using a UAT version of the workbook " & vbNewLine & _
                "The latest registered version is " & Format(dVer, "0.00") & vbNewLine & vbNewLine & _
                "Please notify EUC team to register this version.", vbCritical
    Else
        MsgBox "This is the latest version of the application.", vbOKOnly
    End If

End Sub

0 个答案:

没有答案