Question

我有一个带有Activex控件的工作表（Combobox，命令按钮，选项按钮，CheckBox）。在我的计算机上，我重命名了所有控件（例如CButtonPMR，OButton_Comp等）但是当我在其他计算机上打开文件时，所有控件都被重命名为默认名称（CheckBox1，Checkbox2，CommandButton1等）因此，代码不适用于其他计算机。我每次都会收到错误，因为代码无法编译。有办法解决这个问题吗？

我基本上有2个表单合为一个，有2个选项按钮可以选择你想要的一个。当用户选择按钮时，其他形式为隐藏

 Private Sub OpButtonComp_Click()
 Dim ws As Worksheet
 Set ws = ThisWorkbook.Sheets("Sheet1")
Dim protect As Boolean
protect = False
If ActiveSheet.ProtectContents Then
        protect = True
        ActiveSheet.Unprotect Password:="password"
End If
Application.ScreenUpdating = False


ActiveSheet.Rows("13:61").Hidden = True
ActiveSheet.Rows("62:86").Hidden = False
ActiveSheet.Rows("6").Hidden = True
Dim rng As Range
Set rng = ActiveSheet.Range("A62:P62")
   With ActiveSheet.OLEObjects("CButtonPMB")
       .Top = rng.Top
        .Left = rng.Left
        .Width = rng.Width
        .Height = rng.RowHeight
    End With
ActiveSheet.OLEObjects("CButtonPMB").Visible = True


   Set rng = ActiveSheet.Range("A72:P72")
    With ActiveSheet.OLEObjects("CButtonMQSB")
        .Top = rng.Top
        .Left = rng.Left
        .Width = rng.Width
        .Height = rng.RowHeight
    End With
ActiveSheet.OLEObjects("CButtonMQSB").Visible = True

   Set rng = ActiveSheet.Range("A79:P79")
    With ActiveSheet.OLEObjects("CButtonMQS2B")
        .Top = rng.Top
        .Left = rng.Left
        .Width = rng.Width
        .Height = rng.RowHeight
    End With
ActiveSheet.OLEObjects("CButtonMQS2B").Visible = True

   Set rng = ActiveSheet.Range("A85:P85")
    With ActiveSheet.OLEObjects("CButtonPM2B")
        .Top = rng.Top
        .Left = rng.Left
        .Width = rng.Width
        .Height = rng.RowHeight
    End With
ActiveSheet.OLEObjects("CButtonPM2B").Visible = True


Application.ScreenUpdating = True
If Not (ActiveSheet.ProtectContents) And protect = True Then
            ActiveSheet.protect Password:="password"
            End If

End Sub





Private Sub OpButtonCon_Click()
Dim protect As Boolean
protect = False
If ActiveSheet.ProtectContents Then
        protect = True
        ActiveSheet.Unprotect Password:="password"
End If
Application.ScreenUpdating = False


ActiveSheet.Rows("13:61").Hidden = False
ActiveSheet.Rows("62:86").Hidden = True
ActiveSheet.Rows("6").Hidden = False
ActiveSheet.CButtonPMB.Visible = False
ActiveSheet.CButtonMQSB.Visible = False
ActiveSheet.CButtonMQS2B.Visible = False
ActiveSheet.CButtonPM2B.Visible = False

Application.ScreenUpdating = True
If Not (ActiveSheet.ProtectContents) And protect = True Then
            ActiveSheet.protect Password:="password"
            End If

End Sub

这是在选择这些单元格时弹出DatePicker表单。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


      '   Only look at that range

    If Intersect(Target, Range("N12:P12")) Is Nothing _
    And Intersect(Target, Range("N15:P15")) Is Nothing _
    And Intersect(Target, Range("N29:P29")) Is Nothing _
    And Intersect(Target, Range("N37:P37")) Is Nothing _
    And Intersect(Target, Range("N44:P44")) Is Nothing _
    And Intersect(Target, Range("N50:P50")) Is Nothing _
    And Intersect(Target, Range("N51:P51")) Is Nothing _
    And Intersect(Target, Range("N59:P59")) Is Nothing _
    And Intersect(Target, Range("N70:P70")) Is Nothing _
    And Intersect(Target, Range("N78:P78")) Is Nothing _
    And Intersect(Target, Range("N83:P83")) Is Nothing Then
        Exit Sub
    Else
    'Show Datepicker
        CalendarFrm.Show
    End If
End Sub

谢谢

由于我的答案已被删除，我将在此处发布解决方案。如果有人想知道，我设法通过遵循http://www.excelclout.com/microsoft-update-breaks-excel-activex-controls-fix/

来解决问题

将以下VBA代码复制并粘贴到电子表格中的任何模块中。

Public Sub RenameMSFormsFiles() 
    Const tempFileName As String = "MSForms - Copy.exd"  
    Const msFormsFileName As String = "MSForms.exd"  
    On Error Resume Next 

    'Try to rename the C:\Users\[user.name]\AppData\Local\Temp\Excel8.0\MSForms.exd file  
    RenameFile Environ("TEMP") & "\Excel8.0\" & msFormsFileName, Environ("TEMP") & "\Excel8.0\" & tempFileName 
    'Try to rename the C:\Users\[user.name]\AppData\Local\Temp\VBE\MSForms.exd file  
    RenameFile Environ("TEMP") & "\VBE\" & msFormsFileName, Environ("TEMP") & "\VBE\" & tempFileName 
End Sub  

Private Sub RenameFile(fromFilePath As String, toFilePath As String) 
    If CheckFileExist(fromFilePath) Then 
        DeleteFile toFilePath  
        Name fromFilePath As toFilePath  
    End If  
End Sub  

Private Function CheckFileExist(path As String) As Boolean 
    CheckFileExist = (Dir(path) <> "")  
End Function  

Private Sub DeleteFile(path As String) 
    If CheckFileExist(path) Then 
        SetAttr path, vbNormal  
        Kill path  
    End If  
End Sub

在workbook_Open事件的最开始调用RenameMSFormsFiles子例程。

Private Sub Workbook_Open() 
    RenameMSFormsFiles  
End Sub

Excel在其他计算机上重命名Activex控件

0 个答案: