I have a worksheet with Activex Controls(Combobox, Command Button, Option Button, CheckBox). On my computer I have renamed all the controls (Ex. CButtonPMR, OButton_Comp, etc) But when I open the file on other computer all the controls are renamed to default the default names (CheckBox1,Checkbox2, CommandButton1, etc) For that reason the code doesn't works on other computers. I am getting errors every time because the code can't compile. Is there a way to fix this?
I basically have 2 forms into one and there is 2 option button to chose wich one you want. When the user select a Button the other 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 is to pop up a DatePicker Form when those 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 you
Since my answer was deleted I'll post the solution here. If anyone is wondering, 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