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
source to share
No one has answered this question yet
See similar questions:
or similar: