Excel renames ActiveX controls on other computers

I have a worksheet with ActiveX controls (Combobox, Command Button, Option Button, CheckBox). On my computer, I renamed all the controls (e.g. CButtonPMR, OButton_Comp, etc.), but when I open the file on another computer, all the controls are renamed by default (CheckBox1, Checkbox2, CommandButton1, etc.) For this reason, the code does not work on other computers. I am getting errors every time because the code cannot compile. Is there a way to fix this?

I basically have 2 forms in one and there are 2 select buttons that you have selected exactly the way you want. When the user selects a button, another form is hidden


 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

      

This will pop up the DatePicker when these cells are selected.

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

      

thank

Since my answer has been deleted, I'll post the solution here. If anyone is interested, I managed to fix it by following this http://www.excelclout.com/microsoft-update-breaks-excel-activex-controls-fix/

Copy and paste the following VBA code into any module in the spreadsheet.

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 

      

Call the RenameMSFormsFiles subroutine at the very beginning of the workbook_Open event.

Private Sub Workbook_Open() 
    RenameMSFormsFiles  
End Sub

      

0


source to share





All Articles