可以通过为多个用户的Excel添加来更新Excel VBA代码

Question

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

目前，我的VBA代码居住在分布式Excel工作簿中。我担心我会面临的问题是，如果需要任何更新，请更新每个工作簿VBA代码。

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

我从我的原始工作簿文件中创建了一个XLAM文件。原始工作簿文件包含我所有的子例程，功能和用户形式。即使我引用了包含UserForm1的XLAM文件，我也会遇到错误。

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

方案1：调用分配给形状的子的用户形式以下子返回Runtime Error 424 Object Required

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

方案2：从调用用户形式的形状调用子过程此方法不会返回错误，为什么？我们不能从引用的添加中引用用户形式对象吗？

Sub RectangleRoundedCorners1_Click()
showUserForm
End Sub
Sub showUserForm()
UserForm1.Show
End Sub

方案3：使用用户形式将值输入工作表小区

我是否必须在每个用户形式中屈服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

我相信这会给您带来编译错误。在这里记录了这种行为以及建议的解决方案，尽管它有点" hacky"，但我自己使用了这种行为。但这是有效的，这就是Microsoft告诉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改变这种方法，如下所述。我使用的是该博客中提倡的类似方法，该方法效果很好，但可能会让您陷入学习和编写您不知道您在代码中所需的东西的兔子漏洞。绝对使在我的经验中保持代码变得更容易。您可以查看有关该主题的一些问题。

在方案3 在我看来，您需要以现在写作的方式参考ActiveWorkbook。但是我强烈倡导创建一个类，该类将以Workbook或Worksheet(或Shape或DATA或其他类(最好是界面(或实际需要做其工作需要做的任何事情(并将责任承担责任Button_Click事件：

在ProjectB中：

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

类工作表manipulator：

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

在Projecta中：

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，私有字段，可以返回类中的变量，更好的名称等。