已更新,希望更好地遵守论坛规则。
我为我的组织构建了一个广泛的程序,需要定期更新。
我尝试过一个宏,删除除了自身之外的所有旧宏,然后从中央存储库重新导入,但是我遇到了命名问题。
下面的源代码。我在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/