如何维护具有多个用户的分布式VBA宏

时间:2017-09-06 14:07:05

标签: excel vba excel-vba excel-addins

已更新,希望更好地遵守论坛规则。

我为我的组织构建了一个广泛的程序,需要定期更新。

我尝试过一个宏,删除除了自身之外的所有旧宏,然后从中央存储库重新导入,但是我遇到了命名问题。

下面的源代码。我在excel工作表中有引用位置,它从中打开参考工作簿。宏删除旧宏,然后导入新宏。问题是即使旧的宏已被删除,它仍然用两个命名文件。如何让它重置回原始名称。

Sub SystemUpdate()

'Defining Variables
    Dim ws As Worksheet, PReference As String
    Dim strPath As String
    Dim Source As Workbook
    Dim Target As Workbook
    Dim VersionSource As Long
    Dim VersionTarget As Long
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    Dim EVMBook As String

    'Resets Clipboard to ensure memory space
        Dim clipboard As MSForms.DataObject
        Set clipboard = New MSForms.DataObject
        clipboard.Clear

    'Checks if the Auto Update Function is On
    If MainMenu.OnButton = True Then
        Application.DisplayAlerts = False

    'System Check for Updates
        'PReference = MainMenu.Range("D34").Value
        EVM = ActiveWorkbook.Name
        Set Target = Workbooks(EVM)
        VersionTarget = Workbooks(EVM).Worksheets("Main Menu").Range("Y4").Value
        Workbooks(EVM).Worksheets("Main Menu").Range("D36").Value = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
        Targetloc = MainMenu.Range("D36").Value

        Call Z_UpdateStorage.SourcePath(1)
        Call Z_UpdateStorage.SourcePath(2)
    'Section 2 Opens Reference File

        'MsgBox ("X:\projects\Program_Control\Macros\Program Overview Master Files\" & PReference)
        'Workbooks.Open Filename:=MainMenu.Range("D34").Value
        Reference = MainMenu.Range("D34").Value
        Set Source = Workbooks.Open(Reference)
        Reference = ActiveWorkbook.Name
        VersionSource = Workbooks(Reference).Worksheets("Main Menu").Range("Y4").Value

     If VersionSource > VersionTarget Then

        Call ModuleDelete(Target)
'Reimport Modules

    'A_ImportModule
        Const strTextFile = "A_ImportModule.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("A_ImportModule").Export strPath & strTextFile
        Target.VBProject.VBComponents.Import strPath & strTextFile
        Kill strPath & strTextFile

    'DataValidation
        Const strTextFile1 = "DataValidation.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("DataValidation").Export strPath & strTextFile1
        Target.VBProject.VBComponents.Import strPath & strTextFile1
        Kill strPath & strTextFile1

    'ETCSpreads
        Const strTextFile2 = "ETCSpreads.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("ETCSpreads").Export strPath & strTextFile2
        Target.VBProject.VBComponents.Import strPath & strTextFile2
        Kill strPath & strTextFile2

    'ExportModule
        Const strTextFile3 = "ExportModule.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("ExportModule").Export strPath & strTextFile3
        Target.VBProject.VBComponents.Import strPath & strTextFile3
        Kill strPath & strTextFile3

    'Format
        Const strTextFile4 = "Formating.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("Format").Export strPath & strTextFile4
        Target.VBProject.VBComponents.Import strPath & strTextFile4
        Kill strPath & strTextFile4

    'HeadCount
        Const strTextFile5 = "HeadCount.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("HeadCount").Export strPath & strTextFile5
        Target.VBProject.VBComponents.Import strPath & strTextFile5
        Kill strPath & strTextFile5

    'LaborData
        Const strTextFile6 = "LaborData.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("LaborData").Export strPath & strTextFile6
        Target.VBProject.VBComponents.Import strPath & strTextFile6
        Kill strPath & strTextFile6

    'Report
        Const strTextFile8 = "Report.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("Report").Export strPath & strTextFile8
        Target.VBProject.VBComponents.Import strPath & strTextFile8
        Kill strPath & strTextFile8

    'Stoplight
        Const strTextFile9 = "Stoplight.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("Stoplight").Export strPath & strTextFile9
        Target.VBProject.VBComponents.Import strPath & strTextFile9
        Kill strPath & strTextFile9

'    TPRs
        Const strTextFile10 = "TPRs.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("TPRs").Export strPath & strTextFile10
        Target.VBProject.VBComponents.Import strPath & strTextFile10
        Kill strPath & strTextFile10

    'X_ReferenceInfo
        Const strTextFile11 = "X_ReferenceInfo.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
            Source.VBProject.VBComponents("X_ReferenceInfo").Export strPath & strTextFile11
            Target.VBProject.VBComponents.Import strPath & strTextFile11
            Kill strPath & strTextFile11

    'X_SystemUpdate

        Const strTextFile12 = "X_SystemUpdate.bas"
        strPath = Environ("Temp")
        If Right(strPath, 1) <> "\" Then
            strPath = strPath & "\"
        End If
        Source.VBProject.VBComponents("X_SystemUpdate").Export strPath & strTextFile12
        Target.VBProject.VBComponents.Import strPath & strTextFile12
        Kill strPath & strTextFile12

    'Program List
      Windows(Reference).Activate
            Sheets("Programs").Select
            Cells.Select
            Selection.Copy
            Windows(EVM).Activate
            Sheets("Programs").Select
            Range("A1").Select
            Sheets("Programs").Paste
            Application.CutCopyMode = False
            Windows(Reference).Activate

        'Calendar List
        Windows(Reference).Activate
            Sheets("Net Month Hrs").Select
            Cells.Select
            Selection.Copy
            Windows(EVM).Activate
            Sheets("Net Month Hrs").Select
            Range("A1").Select
            Sheets("Net Month Hrs").Paste
            Application.CutCopyMode = False
            Sheets("Net Month Hrs").Select
            Range("X2").Select
            ActiveCell.FormulaR1C1 = "=VLOOKUP(MONTH('Main Menu'!R[6]C[-12]),'Net Month Hrs'!RC[-5]:R[11]C[-1],5)"
            Range("X11").Select
            ActiveCell.FormulaR1C1 = _
            "=IF(MONTH('Main Menu'!R[-3]C[-12])<10,YEAR('Main Menu'!R[-3]C[-12])&0&MONTH('Main Menu'!R[-3]C[-12]),YEAR('Main Menu'!R[-3]C[-12])&MONTH('Main Menu'!R[-3]C[-12]))"
            Sheets("Main Menu").Select
            Range("L30").Select
            ActiveCell.FormulaR1C1 = _
            "=IF(R[-16]C-R[-16]C[-8]=R[-20]C,VLOOKUP(R[-16]C[-8]+R[-20]C,'Net Month Hrs'!R[-28]C[-2]:R[23]C[1],3,FALSE)+2,VLOOKUP(R[-16]C[-8]-1,'Net Month Hrs'!R[-28]C[-2]:R[23]C[1],3,FALSE)+2)"
            Windows(Reference).Activate

      Workbooks(EVM).Worksheets("Main Menu").Range("Y4").Value = VersionSource
      Source.Close

    Updated = True

    Exit Sub

    Else
       Source.Close
       Updated = False
       Call MessageBoxTimer
    End If
    Application.DisplayAlerts = True

ElseIf MainMenu.OffButton = True Then
    Ignore = MsgBox("The Following Updates will not be installed", vbOKCancel, "Ignore Auto Update")
    NameUpdate = False
End If

End Sub

Sub PrepReferenceFile()

Application.DisplayAlerts = False

For Each wsa In Worksheets

    If wsa.Name <> "Main Menu" And wsa.Name <> "User Directions" _
        And wsa.Name <> "Programs" And wsa.Name <> "Net Month Hrs" _
        And wsa.Name <> "Modules Definitions" And wsa.Name <> "RevisionLog" _
        And wsa.Name <> "References" And wsa.Name <> "Modules" Then wsa.Delete
Next

Application.DisplayAlerts = True
End Sub

Sub Rename()
        Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("X_SystemUpdate1")
        VBCodMod2.Name = "X_SystemUpdate"
        Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("a_ImportModule1")
        VBCodMod2.Name = "a_ImportModule"
        Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("DataValidation1")
        VBCodMod2.Name = "DataValidation"
        Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("X_ReferenceInfo1")
        VBCodMod2.Name = "X_ReferenceInfo"
        Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("Report1")
        VBCodMod2.Name = "Report"
End Sub

Sub MessageBoxTimer()
    Dim AckTime As Integer, InfoBox As Object
    Set InfoBox = CreateObject("WScript.Shell")
    'Set the message box to close after 10 seconds
    AckTime = 5
    Select Case InfoBox.Popup("File is Up to Date", _
    AckTime, "This is your Message Box", 0)
        Case 1, -1
            Exit Sub
    End Select
End Sub

Sub ModuleDelete(Target As Workbook)

'A_ImportModule
        With Target.VBProject.VBComponents
            .Remove .Item("A_ImportModule")
        End With

'DataValidation
           With Target.VBProject.VBComponents
            .Remove .Item("DataValidation")
        End With

'ETCSpreads
        With Target.VBProject.VBComponents
            .Remove .Item("ETCSpreads")
        End With

'ExportModule
        With Target.VBProject.VBComponents
            .Remove .Item("ExportModule")
        End With

'Format
        With Target.VBProject.VBComponents
            .Remove .Item("Format")
        End With

'HeadCount
        With Target.VBProject.VBComponents
            .Remove .Item("HeadCount")
        End With

'LaborData
        With Target.VBProject.VBComponents
            .Remove .Item("LaborData")
        End With
'Report
        With Target.VBProject.VBComponents
            .Remove .Item("Report")
        End With
'Stoplight
        With Target.VBProject.VBComponents
            .Remove .Item("Stoplight")
        End With
'TPRs
        With Target.VBProject.VBComponents
            .Remove .Item("TPRs")
        End With

'X_ReferenceInfo
        With Target.VBProject.VBComponents
            .Remove .Item("X_ReferenceInfo")
        End With

'X_SystemUpdate
         With Target.VBProject.VBComponents
            .Remove .Item("X_SystemUpdate")
        End With
Exit Sub
End Sub

我的来源是http://www.cpearson.com/Excel/Topic.aspx http://what-when-how.com/excel-vba/creating-excel-add-ins/

0 个答案:

没有答案
相关问题