VBA ActiveX控件问题

Question

工作表中插入了一些可供选择的ActiveX控件，想在关闭工作簿之前提示是否将信息录入到汇总表中。但程序运行后sheet2工作表会变成sheet21，sheet2变成了Activex部件，后续运行sheet2后面都会增加个1。运行几次后：

选择sheet2111工程后是这样的：

代码：

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim response
    response = MsgBox("是否将修改的文件保存并同步到到委托信息统计表中？", vbYesNoCancel)
    If response = vbYes Then
        Dim wb, sht, wb1, sht1, arr, currentPath As String, parentPath As String, x As String, y As String, r As Long, _
        strkey As String, myrange, myrow, trow As Long, i As Integer
        Set wb = ActiveWorkbook
        Set sht = wb.Sheets("检测委托书")
        ReDim arr(1 To 22)
        With sht
            arr(1) = .Range("B2")
            arr(2) = .Range("F2")
            arr(3) = .Range("C3")
            arr(4) = .Range("C4")
            arr(5) = .Range("C9")
            If .OptionButton1 = True Then arr(6) = "委托检测"
            If .OptionButton2 = True Then arr(6) = "比对检测"
            If .OptionButton3 = True Then arr(6) = "复检"
            If .OptionButton4 = True Then arr(6) = "体系认证"
            If .OptionButton5 = True Then arr(6) = "环评"
            If .OptionButton6 = True Then arr(6) = .Range("J6")
            If .CheckBox1 = True Then arr(7) = "技术说明书 "
            If .CheckBox2 = True Then arr(7) = arr(7) & "企业标准 "
            If .CheckBox3 = True Then arr(7) = arr(7) & .Range("H7")
            If .CheckBox4 = True Then arr(8) = "采样检测 "
            If .CheckBox5 = True Then arr(8) = arr(8) & "现场检测 "
            If .CheckBox6 = True Then arr(8) = arr(8) & .Range("I8")
            arr(9) = "采样"
            arr(10) = "/"
            arr(11) = "/"
            arr(12) = "/"
            arr(13) = "/"
            arr(14) = "/"
            arr(15) = .Range("G9")
            If .OptionButton7 = True Then arr(16) = "每个样品出一份"
            If .OptionButton8 = True Then arr(16) = "每个委托单出一份"
            If .CheckBox7 = True Then arr(17) = "附采样点照片 "
            If .CheckBox8 = True Then arr(17) = arr(17) & "附点位图 "
            If .CheckBox9 = True Then arr(17) = arr(17) & "报告副本 "
            If .CheckBox10 = True Then arr(17) = arr(17) & "附限值"
            If .OptionButton9 = True Then arr(18) = "否"
            If .OptionButton10 = True Then arr(18) = "是"
            If .OptionButton11 = True Then arr(19) = "否"
            If .OptionButton12 = True Then arr(19) = "是"
            If .CheckBox11 = True Then arr(20) = "自取 "
            If .CheckBox12 = True Then arr(20) = arr(20) & "邮寄 "
            If .CheckBox13 = True Then arr(20) = arr(20) & "电传 "
            If .CheckBox14 = True Then arr(20) = arr(20) & .Range("H14")
            arr(21) = .Range("D15")
            arr(22) = .Range("B17")
        End With
        
        currentPath = wb.Path
        parentPath = Left(currentPath, InStrRev(currentPath, "\"))

        x = "20" & Mid(sht.Range("B2"), 3, 4) & "委托信息统计表.xlsx"
        y = sht.Range("K2")
        Workbooks.Open (parentPath & x)
        Set wb1 = ActiveWorkbook
        Set sht1 = wb1.Sheets(y)
        trow = sht1.Cells(Rows.Count, 2).End(xlUp).Row
        strkey = sht.Range("B2")
        Set myrange = sht1.Range("B2:B" & trow).Find(what:=strkey, lookat:=xlWhole)
        If myrange Is Nothing Then
            r = trow + 1
        Else
            r = myrange.Row
        End If
        For i = 2 To 23
            sht1.Cells(r, i) = arr(i - 1)
        Next i
        
        wb1.Save
        wb1.Close
      
        Set sht = Nothing
        Set sht1 = Nothing
        Set wb = Nothing
        Set wb1 = Nothing
        Set myrange = Nothing
    Else
        Cancel = True
    End If
End Sub

程序运行正常。

Answer 1

以下回复参考：皆我百晓生、券券喵儿等免费微信小程序作答:

在您的VBScript程序中，您尝试在一个名为Workbook_BeforeSave的方法中处理工作簿保存时的问题。这个方法的主要目的是检查用户是否希望在保存文件的同时同步到一个名为委托信息统计表.xlsx的工作簿中。为了实现这一功能，您可以按照以下步骤进行：

步骤 1: 创建数据源

首先，确保在工作簿中有一个包含您要添加的数据的区域，例如，创建一个表格，并将数据填充进去。

步骤 2: 使用ActiveX对象模型（AMO）处理

为了允许用户从当前工作簿中选择数据并将其复制到新的工作簿中，您需要利用ActiveX对象模型（AMO）。这可以通过使用Selection.Copy和Selection.PasteSpecial函数来完成。

步骤 3: 验证用户行为

当用户决定保存并同步数据时，您可以使用MsgBox弹出一个确认对话框询问用户是否确实想要这样做。如果用户点击了“是”，则可以继续执行下一步；否则，程序应终止并返回用户的选择。

步骤 4: 实现逻辑

接下来，结合上述步骤，编写一个函数来实现用户界面的功能。这里是一个简单的示例，展示了如何在用户点击“是”按钮后，通过AMO将选定的数据复制到新工作簿中。

VBA脚本示例

Private Sub CheckUserIntent()
    Dim intent As Boolean
    ' 获取用户选择的数据范围
    Dim selRange As Range
    
    ' 假设您已经定义了一个名为`selRange`的变量，其中存储了用户的选中文本
    ' 如果没有定义，您可以简单地获取当前活动单元格以获取数据范围
    Set selRange = Selection
    
    ' 检查用户是否选择了数据
    If Not selRange Is Nothing And selRange.Value <> "" Then
        ' 显示确认对话框
        intent = MsgBox("是否确认将选定的数据复制到新的工作簿中？", vbYesNoCancel)
        
        ' 根据用户的选择显示不同的结果
        Select Case intent
            Case vbYes
                ' 用户确认，开始操作
                ' 在此添加实际的操作代码
            Case vbNo
                ' 用户取消，结束程序
                Exit Sub
            Case vbCancel
                ' 用户放弃，退出循环
                Exit Sub
        End Select
    Else
        ' 如果未选择任何数据，提示用户选择数据
        MsgBox "请选择您想要复制的数据！"
    End If
End Sub

步骤 5: 连接ActiveX对象模型

请注意，由于ActiveX对象模型可能涉及到特定于Microsoft Office的API，因此在真实的项目中，您可能需要根据实际情况调整这些代码片段。此外，如果您正在开发跨平台应用，可能需要考虑使用更广泛的API来替代ActiveX对象模型。

结论

通过以上步骤，您可以在不依赖于ActiveX对象模型的情况下，为用户提供一个简单而直观的方式来在保存文件的同时同步数据。这样不仅提高了应用程序的可扩展性，还简化了用户界面的设计。