I have a simple Sub to set a checkbox (placed on a worksheet) depending on whether or not a Worksheet is protected.
chkToggleProtect absolutely exists, by I'm getting a compile error on either of the lines where I reference it -
Variable not defined
Any ideas what I'm doing wrong?
Private Sub SetToggleProtect(ByRef isprotected As Boolean)
If isprotected Then
chkToggleProtect.Checked = True
Else
chkToggleProtect.Checked = False
End If
End Sub
The reason is exactly the error thrown: the variable does not exist as far as this sub is concerned. Remember to fully qualify everything.
If this is a Forms checkbox, the following will work:
Private Sub CheckACheckbox(isProtected As Boolean)
Dim cb As CheckBox
If cb.Name = "ModifyMe" Then
If isProtected Then
cb.Value = True
Else
cb.Value = False
End If
End If
End Sub
Modify accordingly to suit.
So after some giggery-pokery with the Immediate windows (my new best friend), I found that I could access the Forms control placed on my worksheet like this -
Private Sub SetToggleProtect(ByRef IsProtected As Boolean)
If IsProtected Then
WS.Shapes("chkToggleProtect").ControlFormat.Value = xlOn
Else
WS.Shapes("chkToggleProtect").ControlFormat.Value = xlOff
End If
End Sub
Related
I have code on a userform that contains several checkboxes and several DTPickers.
The code looks like so:
Private Sub CheckBox11_Click()
If CheckBox11.Value = True Then
DTPicker22.Enabled = True
Else
DTPicker22.Enabled = False
End If
End Sub
Private Sub CheckBox12_Click()
If CheckBox12.Value = True Then
DTPicker24.Enabled = True
Else
DTPicker24.Enabled = False
End If
End Sub
The Userform contains a lot of checkboxes that have clauses next to them. Upon their completion the DTPicker will enable entering the date of completion.
Whilst this does what I want, it only enables one DTPicker when the checkbox is ticked per private sub. There has to be some way to make this so I wouldn't need to create different private subs for every checkbox click event.
Could you also tell me where to put it, as in, what event?
A "control array" is the typical approach for something like this.
See:
http://www.siddharthrout.com/index.php/2018/01/15/vba-control-arrays/
eg:
Class module clsEvents
Option Explicit
'Handle events for a checkbox and a date control, associated with a worksheet cell
Private WithEvents m_CB As MSForms.CheckBox
Private WithEvents m_DP As DTPicker
Private m_dateCell As Range
'set up the controls and the cell
Public Sub Init(cb As MSForms.CheckBox, dp As DTPicker, rng As Range)
Set m_CB = cb
Set m_DP = dp
Set m_dateCell = rng
If rng.Value > 0 Then
cb.Value = True
m_DP.Value = rng.Value
Else
cb.Value = False
End If
m_DP.CustomFormat = "dd/MM/yyyy"
End Sub
Private Sub m_CB_Change()
m_DP.Enabled = (m_CB.Value = True)
End Sub
Private Sub m_DP_Change()
m_dateCell.Value = m_DP.Value 'update the cell
End Sub
Userform:
Option Explicit
Dim colObj As Collection 'needs to be a Global to stay in scope
Private Sub UserForm_Activate()
Dim obj As clsEvents, i As Long, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set colObj = New Collection
'loop over controls and create a class object for each set
' 3 pairs of controls on my test form...
For i = 1 To 3
Set obj = New clsEvents
obj.Init Me.Controls("CheckBox" & i), _
Me.Controls("DTPicker" & i), _
ws.Cells(i, "B")
colObj.Add obj
Next i
End Sub
The first thing I'd recommend is following a proper naming convention. "CheckBox11" and "DTPciker1" are really vague and once you get further into your code, you'll forget which control is which. I would recommend naming them something that relates the two control together, like "firstDate" and "firstDateDTP". My alternate answer below uses this approach.
You could make a public function that enables the DTPicker based upon the checkbox's value.
Public Function EnableDTPicker(myPicker as String, enableBool as Boolean)
UserFormName.Controls(myPicker).Enabled = enableBool
End Function
Then, you can call the function in your CheckBox123_Click() subs like this:
Private Sub CheckBox123_Click()
EnableDTPicker("thePickerName", CheckBox123.Value)
End Sub
Alternatively, you could make a timer event that runs x number of seconds that just loops through the controls and performs the checks as needed. See this page on how to set up the timer. Using the code in the link shown, You could do something along the lines of:
'Put this in Workbook events
Private Sub Workbook_Open()
alertTime = Now + TimeValue("00:00:01")
Application.OnTime alertTime, "EventMacro"
UserForm1.Show
End Sub
'Put this in a Module
Public Sub EventMacro()
With UserForm1
For each ctrl in .Controls
If TypeName(ctrl) = "CheckBox" Then
'The code below assumes the naming convention outlined above is followed
.Controls(ctrl.Name & "DTP").Enabled = ctrl.Value
End If
Next ctrl
End With
alertTime = Now + TimeValue("00:00:01")
Application.OnTime alertTime, "EventMacro"
End Sub
I've written the following code so that if a certain text exists in my listbox and "ok" button is clicked a certain thing is done.
Private Sub CommandButton3_Click()
If (Me.ListBox2.Text) <> ("PA") Then
Call macro1
ElseIf (Me.ListBox2.Text) <> "menu" Then
Sheets("menu").Visible = xlSheetVisible
Worksheets("menu").Activate
Else
MsgBox "Nothing is selected"
End If
End Sub
The problem is that when "ok" is clicked all events are still carried out even if the specified text isn't in the textbox.
You probably want to use = operator, and not <> operator. Also note that ListBox.List(i) is the correct way of getting selected item for single selection mode:
Private Sub CommandButton3_Click()
Dim SelectedItem = ListBox1.List(ListBox1.ListIndex)
If SelectedItem = "PA" Then
Call macro1
ElseIf SelectedItem = "menu" Then
Sheets("menu").Visible = xlSheetVisible
Worksheets("menu").Activate
Else
MsgBox "Nothing is selected"
End If
End Sub
Edit
Following your comment, you can create a function that looks for the existence of that item:
Private Function TextExists(text as String) as Boolean
Dim i as Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.List(i) = text Then
TextExists = True
Exit Function
End If
Next
TextExists = False
End Function
And then use this function in the main code like this:
Private Sub CommandButton3_Click()
If TextExists("PA") Then
Call macro1
ElseIf TextExists("menu") Then
Sheets("menu").Visible = xlSheetVisible
Worksheets("menu").Activate
Else
MsgBox "Nothing is selected"
End If
End Sub
N.B. I have written this manually here, without an IDE. Please check for indexes and other little things.
Iam trying to create a simple if statement in Excel with VBA.
I'm creating a new checkbox
Adds the following code to the box.
Sub CheckBox1_Click()
HideRows "2:5"
End Sub
Sub HideRows(rowRange)
If CheckBox1 = False Then
Rows(rowRange).EntireRow.Hidden = True
Else: Rows(rowRange).EntireRow.Hidden = False
End If
End Sub
Result: The rows are hidden both if the checkbox is checked or unchecked.
(checkbox is checked)
All rows are visible
Uncheck the checkbox
Result: All rows are hidden
(checkbox is unchecked)
All rows are visible
Uncheck the checkbox
Result: All rows are hidden
You want it in a Change Event.
You do not need the If Then. CheckBox1 rturns a TRUE/FALSE, just use that.
And the EntireRow is also not needed when refering to Rows(). You are already refering to the whole row.
Also, it is good practice to always declare the parent to any Range Object, which Rows() is. If the the code is in the Worksheet code then use Me as it will refer to itself. If the code is in a module then use ActiveSheet or more preferably the specific sheet, Worksheets("Sheet1") :
Private Sub CheckBox1_Change()
HideRows "2:5"
End Sub
Sub HideRows(rowRange)
'if this code is not in the worksheet code then change `Me` to `ActiveSheet`
Me.Rows(rowRange).Hidden = Not CheckBox1
End Sub
Assuming its an ActiveX CheckBox, place this code in Sheet Module...
Private Sub CheckBox1_Click()
If CheckBox1 = True Then
Rows("2:5").Hidden = True
Else
Rows("2:5").Hidden = False
End If
End Sub
Edit:
Or just use this...
Private Sub CheckBox1_Click()
Rows("2:5").Hidden = CheckBox1
End Sub
You can put this in one sub, assuming its an activeX checkbox
Private Sub CheckBox1_Click()
If CheckBox1 = True Then
[2:5].EntireRow.Hidden = False
Else: [2:5].EntireRow.Hidden = True
End If
End Sub
When I start my Userform, I first chack for a value. If this value is not existing the userform should close.
Try1: UserForm_Inizialize
Public Sub UserForm_Initialize()
Call languagePack
'
'initialize the userform
'
End Sub
Try1: function to choose a languagepack
Private Sub languagePack()
Dim LanguageItems(45) As String
Dim Language_ID As Integer
Language_ID = Outlook.LanguageSettings.LanguageID(msoLanguageIDUI)
Call Language_AS.getLanguage(Language_ID, LanguageItems)
If Not LanguageItems(0) = "" Then
With Me
'--write the array items into the userform objects and vaues
End With
Else
MsgBox "It doesn't exist a Language-Pack for your language! Pleas change to english."
Unload Advanced_Search ' will not work
End If
End Sub
Try1 was to unload the userform in the function languagePack(), but didnt stop run and I get an error. So I tried another thing:
Try2: UserForm_Inizialize
Private close_userform As Boolean
Public Sub UserForm_Initialize()
Call languagePack
If close_userform = Flase Then
'
'initialize the userform
'
else
Unload Advanced_Search ' will not work
end if
End Sub
Try2: function to choose a languagepack
Private Sub languagePack()
Dim LanguageItems(45) As String
Dim Language_ID As Integer
Language_ID = Outlook.LanguageSettings.LanguageID(msoLanguageIDUI)
Call Language_AS.getLanguage(Language_ID, LanguageItems)
If Not LanguageItems(0) = "" Then
With Me
'
'--write the array items into the userform objects and vaues
'
End With
close_userform = False
Else
MsgBox "It doesn't exist a Language-Pack for your language! Pleas change to english."
close_userform = True
End If
End Sub
Whats wrong on Try2? The Boolean close_userform is global so both functions can read the value. But if it reachs the unload it happen nothing. After reaching the end sub I get an error.
The error is: Run-time error '91':
Objective variable or With block variable not set
Macro that starts the Userform
Sub start_Advanced_Search()
Advanced_Search.Show (vbModeless)
End Sub
Pleas help me. Thanks for every command an answer. Kind regards, Nico
Why not make the languagePack sub a function that returns a Boolean instead of writing the result to close_userform. Next use Unload Me instead Unload Advanced_Search
That’s the solution of my problem.
Thanks Tom for your help.
Description:
If there is no language pack for my Userform (I make the language packs), it will close the userform.
The function languagePack() returns a boolean (ture = language pack exists | false = no language pack exists).
This boolean is saved in hasLanguage. With the function getHasLanguage() I can get the value outside of the userform.
This function is used in the sub start_Advanced_Search. With the if function I check if there is a language pack, if not it will unload the userform.
Userform
Private hasLanguage As Boolean
Public Sub UserForm_Initialize()
hasLanguage = languagePack()
If hasLanguage Then
'
'set the defaults...
'
End If
End Sub
Public Function getHasLanguage()
getHasLanguage = hasLanguage
End Function
Private Function languagePack() As Boolean
'array to save the new language
Dim LanguageItems(49) As String
'this value will contain the LanguageID of Outlook
Dim language_ID As Integer
'get LanguageID of Outlook
language_ID = Outlook.LanguageSettings.LanguageID(msoLanguageIDUI)
'call a sub to get the language
Call Language_AS.getLanguage(language_ID, LanguageItems)
'there is a languagepack if the first element of "LanguageItems" is not ""
If Not LanguageItems(0) = "" Then
With Me
'
'set the language of the userform
'
End With
languagePack = True
Else
'there is no languagepack
MsgBox "It doesn't exist a Language-Pack for your language! Pleas change to english."
languagePack = False
End If
End Function
Modul
Sub start_Advanced_Search()
'start the userform
Advanced_Search.Show (vbModeless)
'use the get function
If Not Advanced_Search.getHasLanguage() Then
'unload if flase
Unload Advanced_Search
End If
End Sub
I've got a workbook which runs a macro to show the userform Open1 as it opens, using the (very basic) code:
Private Sub Workbook_Open()
Open1.Show
End Sub
This does its job fine - each time I open the workbook, the userform pops up and runs perfectly.
But, I want the userform to appear the first time the workbook is opened only. Is there a way to allow this to happen?
You could use a dummy module which gets deleted the first time you open the spreadsheet...
Something like:
If ModuleExists("DummyModule") Then
Open1.Show
DoCmd.DeleteObject acModule, "DummyModule"
End If
Function ModuleExists(strModuleName As String) As Boolean
Dim mdl As Object
For Each mdl In CurrentProject.AllModules
If mdl.Name = strModuleName Then
ModuleExists = True
Exit For
End If
Next
End Function
Update: as stated, DoCmd isn't used in excel vba. That will teach me to write code without testing it!
The following updated code will work, but in order to access the VB environment, excel needs to be trusted.
There is a setting in the Trust Center>Macro Settings that you can tick for this code to work under Developer Macro Settings
As such, this may not be the way to go as it opens up the possibility of security issues...
Sub RemoveModule()
If ModuleExists("DummyModule") Then
Open1.Show
Dim vbCom As Object: Set vbCom = Application.VBE.ActiveVBProject.VBComponents
vbCom.Remove VBComponent:=vbCom.Item("DummyModule")
End If
End Sub
Function ModuleExists(strModuleName As String) As Boolean
Dim mdl As Object
For Each mdl In Application.VBE.ActiveVBProject.VBComponents
If mdl.Name = strModuleName Then
ModuleExists = True
Exit For
End If
Next
End Function
Try this:
If Sheets("Hide").Cells(1,1) = "1" Then
Open1.Show
Sheets("Hide").Cells(1,1) = "0"
End if
You must create the sheet Hide, and give the cell A1 the value 1, in that case the form will be shown.
After you create the sheet, hide it with this
Sheets("Hide").Visible = xlVeryHidden
And show it with this
Sheets("Hide").Visible = True
Here's an alternative bit of code that will persist between saves and allow you to reset it. No need to create a hidden sheet.
Put this in a module (invoke the DisplayFormIfFirstTime from your Workbook_Open event handler....)
Option Explicit
Private Const cMoniker As String = "FormHasBeenDisplayed"
Private Sub DisplayFormIfFirstTime()
If HasBeenOpened = False Then DisplayForm
End Sub
Public Sub DisplayForm()
MsgBox "Ok, its not a form but a dialog box...", vbInformation
End Sub
Public Function HasBeenOpened() As Boolean
Dim oName As Name
On Error Resume Next
Set oName = Application.Names(cMoniker)
On Error GoTo 0
If Not oName Is Nothing Then
HasBeenOpened = True
Else
Call Application.Names.Add(cMoniker, True, False)
End If
End Function
'Call this to remove the flag...
Public Sub ResetOpenOnce()
On Error Resume Next
Application.Names(cMoniker).Delete
End Sub
Based on the idea supplied by PaulG, I have coded an upgrade that will check for the name and if not found run a function, add the name and save the workbook for a more seemless approach to this problem...
Placed in ThisWorkbook
Private Sub Workbook_Open()
Run "RunOnce"
End Sub
Placed in a module
Sub RunOnce()
Dim Flag As Boolean: Flag = False
For Each Item In Application.Names
If Item.Name = "FunctionHasRun" Then Flag = True
Next
If Flag = False Then
Call Application.Names.Add("FunctionHasRun", True, False)
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
Call RunOnceFunction
End If
End Sub
Private Function RunOnceFunction()
Open1.Show
End Function
Sub ResetRunOnce()
For Each Item In Application.Names
If Item.Name = "FunctionHasRun" Then
Application.Names.Item("FunctionHasRun").Delete
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
End If
Next
End Sub