Excel Vba 代码可以通过 Excel 加载项为多个用户更新吗

Question

我有一个包含大量 VBA 代码的 Excel 工作簿。 VBA 代码由许多子例程、函数和用户表单组成。超过 200 名员工将使用此工作簿。

目前我的 VBA 代码位于分布式 Excel 工作簿中。我担心我会面临的问题是如果需要更新每个 Workbooks VBA 代码。

最好将我的所有 VBA 代码编写为插件的一部分，将插件的新版本上传到站点并让员工从那里下载？如果是这样，我会遇到任何限制或限制吗？这样的功能甚至可能吗？ VB.Net 是更好的解决方案吗？

我从我的原始工作簿文件创建了一个 XLAM 文件。原始工作簿文件包含我所有的子例程、函数和用户窗体。直接调用 UserForm 时遇到错误，即使我引用了包含 UserForm1 的 XLAM 文件。

从分布式工作簿副本运行以下方案。 WorkBook 正在引用 XLAM 文件。

场景 1：从分配给形状的 Sub 调用 UserForm 下面的 Sub 返回一个Runtime Error 424 Object Required

Sub RectangleRoundedCorners1_Click()
UserForm1.Show 'highlights this line on the error, XLAM reference houses UserForm1
End Sub

场景 2：从调用 UserForm 的形状调用子过程 这个方法不返回错误，为什么？我们不能从引用的加载项中引用用户窗体对象吗？

Sub RectangleRoundedCorners1_Click()
showUserForm
End Sub

Sub showUserForm()
UserForm1.Show
End Sub

场景 3：使用 UserForms 将值输入工作表单元格

我是否必须在每个用户窗体中引用ActiveWorkbook？

Private Sub CommandButton1_Click()
Set wb = ActiveWorkbook
Set ws = wb.Sheets("clientmenu")
    forceLogOut
    'clear filter so that we dont mix new customers up

    If ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
        With ws.Shapes("priorities")
            .Fill.ForeColor.RGB = RGB(64, 64, 64)
        End With
    End If


    If contact.value <> "" And result.value = vbNullString Then
        MsgBox "Please enter a result"
        result.BorderColor = vbRed
        result.BackColor = vbYellow
        result.DropDown
        Exit Sub

    ElseIf contact.value = vbNullString And result.value <> "" Then
        MsgBox "Please enter a date"
        contact.BorderColor = vbRed
        contact.BackColor = vbYellow
        Exit Sub

    Else: With ws
            callDate
            callResult
        End With
    End If




    With ws
        lastrow = .Range("A" & Rows.Count).End(xlUp).Row + 1

        If Me.priority_ = vbNullString Then
            ws.Range("A" & lastrow).Interior.Color = vbWhite
            ws.Range("A" & lastrow).Font.Color = RGB(0, 0, 0)

        ElseIf Me.priority_ = "None" Then
            ws.Range("A" & lastrow).Interior.Color = vbWhite
            ws.Range("A" & lastrow).Font.Color = RGB(0, 0, 0)
            ws.Range("B" & lastrow).value = vbNullString

        ElseIf Me.priority_ = "High" Then
            '.Cells(x, 1).Interior.Color = RGB(0, 176, 80)
            ws.Range("A" & lastrow).Font.Color = RGB(0, 176, 80)
            ws.Range("B" & lastrow).value = addnewClient.priority_.Text
        ElseIf Me.priority_ = "Medium" Then
            '.Cells(x, 1).Interior.Color = RGB(255, 207, 55)
            ws.Range("A" & lastrow).Font.Color = RGB(255, 207, 55)
            ws.Range("B" & lastrow).value = addnewClient.priority_.Text
        ElseIf Me.priority_ = "Low" Then
            '.Cells(x, 1).Interior.Color = RGB(241, 59, 59)
            ws.Range("A" & lastrow).Font.Color = RGB(241, 59, 59)
            ws.Range("B" & lastrow).value = addnewClient.priority_.Text
        End If

If Me.client = vbNullString Then
MsgBox "Must enter Clients name in order to proceed"
Exit Sub
ElseIf Me.client <> vbNullString Then

ws.Range("L" & lastrow).value = Format(Now(), "mm/dd/yyyy")

        ws.Range("A" & lastrow).value = addnewClient.client.Text
        ws.Range("A" & lastrow).Font.Name = "Arial"
        ws.Range("A" & lastrow).Font.Size = 18
        ws.Range("A" & lastrow).Font.Bold = True



        ws.Range("B" & lastrow).Font.Name = "Arial"
        ws.Range("B" & lastrow).Font.Size = 14
        ws.Range("B" & lastrow).HorizontalAlignment = xlCenter

        ws.Range("C" & lastrow).value = addnewClient.priority.Text

        ws.Range("C" & lastrow).Font.Name = "Arial"
        ws.Range("C" & lastrow).Font.Size = 14
        ws.Range("C" & lastrow).HorizontalAlignment = xlCenter

        ws.Range("E" & lastrow).value = addnewClient.contact.value
        ws.Range("E" & lastrow).Font.Name = "Arial"
        ws.Range("E" & lastrow).Font.Size = 14
        ws.Range("E" & lastrow).HorizontalAlignment = xlCenter


        ws.Range("G" & lastrow).value = addnewClient.result.Text
        ws.Range("G" & lastrow).Font.Name = "Arial"
        ws.Range("G" & lastrow).Font.Size = 14
        ws.Range("G" & lastrow).HorizontalAlignment = xlCenter


        ws.Range("I" & lastrow).value = addnewClient.segmentType.Text
        ws.Range("I" & lastrow).Font.Name = "Arial"
        ws.Range("I" & lastrow).Font.Size = 14
        ws.Range("I" & lastrow).HorizontalAlignment = xlCenter

        ws.Range("K" & lastrow).value = addnewClient.notes.Text

        If Me.contact = vbNullString Then
        ElseIf Me.contact <> vbNullString Then
            ws.Range("J" & lastrow) = Sheet3.Range("J" & lastrow).value + 1
            ws.Range("J" & lastrow).Font.Name = "Arial"
            ws.Range("J" & lastrow).Font.Size = 14
            ws.Range("J" & lastrow).Font.Bold = True
            ws.Range("J" & lastrow).HorizontalAlignment = xlCenter

        End If
        End If

    End With



    'With Sheet3
    'Sheet3.Range("A" & lastrow & ":K" & lastrow).Interior.Color = vbWhite
    Application.GoTo Range("A" & lastrow), True
    'End With

    wb.Sheets(2).Range("C4") = Format(Now, "mm/dd/yyyy")
    Unload Me

End Sub

Answer 1

关于任何Userform 要了解的一点是，它与任何其他类一样，但带有一个 UI 元素。这意味着它遵循与类非常相似的一组规则。如果您查看Class Module 的属性，您将看到一个名为Instancing 的属性。 VBA 允许两个选项：Private 和 PublicNotCreatable。
如果您选择PublicNotCreatable，则可以使用一个类，但不能在其项目之外实例化它。类似于您的场景 1：

'in Project A:
Dim Cls as ProjectB.TestClass
Set Cls = New ProjectB.TestClass

我相信这会给你一个编译错误。这种行为记录在here along with a proposed solution，我自己使用它，尽管它有点“hacky”。但它有效，这就是微软告诉 VBA 程序员要做的事情。这类似于您的场景 2：

'in ProjectB:
Public Function NewTestClass() as TestClass
     Set NewTestClass = New TestClass
End Function
'in ProjectA:
Public Sub InstantiateTestClass()
    Dim Cls as ProjectB.TestClass 
   'as long as there are no other classes with the same name in your references 
   'you can drop "ProjectB." prefix
    Set Cls = NewTestClass
End Sub

注意我如何使用NewTestClass，它是一个返回TestClass 实例的函数，它与Set xxx = New TestClass 的通常实例几乎相同。所以基本上你需要一个项目内部的函数，它将同一个项目中的类的实例返回给任何外部项目。
鉴于每个 UserForm 都带有一个免费实例，您的 方案 2 可以工作。你可以这样重写：

'in ProjectB:
Public Function NewUserForm() as UserForm1
    Set NewUserForm = New UserForm1
End Function
'in ProjectA:
Public Sub ShowUserForm()
    Dim View as ProjectB.UserForm1
    Set View = ProjectB.NewUserForm
    View.Show
End Sub

现在我建议将UserForm1.Show 更改为as explained here。我使用了与该博客中提倡的类似方法，效果很好，但可能会让您陷入学习和编写您不知道在代码中需要的东西的兔子洞。根据我的经验，绝对可以更轻松地维护代码。您可以查看有关该主题的一些问题，like this one。

在场景 3 中，在我看来是的，您需要引用 ActiveWorkbook 现在的编写方式。但我强烈建议创建一个类，它将采用Workbook 或Worksheet（或Shape 或数据或另一个类（最好带有接口）或任何它实际需要做的工作）作为争论并从Button_Click事件中承担责任：

在项目B中：

Public Function NewWorksheetManipulator() as WorksheetManipulator
    Set NewWorksheetManipulator= New WorksheetManipulator
End Function

类 WorkSheetManipulator：

Private ClientSheet as Worksheet
Private ManipulatedSheet as Worksheet
Public Property Set SheetClients(byval Value as WorkSheet)
    Set ClientSheet = Value
End Property
Public Property Set SheetToManipulate (byval Value as WorkSheet)
    Set ManipulatedSheet = Value
End Property
Public Sub DoStuff()
If ManipulatedSheet.FilterMode Then
    ManipulatedSheet.ShowAllData
    With ClientSheet.Shapes("priorities")
        .Fill.ForeColor.RGB = RGB(64, 64, 64)
    End With
End If
'etc...
End Sub

在项目A中：

Public Sub Private Sub CommandButton1_Click()()
    Dim Manipulator as WorkSheetManipulator
    Set Manipulator = WorkSheetManipulator
    Set Manipulator.SheetClients = ActiveWorkbook.Sheets("clientmenu")
    Set Manipulator.SheetToManipulate = ActiveSheet
    Manipulator.DoStuff
End Sub

现在，我没有测试此代码，但从概念上讲，这是您可以制作更模块化、可移植和有组织的代码的方法。请注意，与我的示例相比，您可以做很多事情：Option Explicit、用于支持类中变量的私有字段、更好的名称等。