I have been able to change the list (or RowSource) of a Combobox dependant on whether an Optionbox has been selected using the following code:
Private Sub optYes_Click()
Options
End Sub
Private Sub optNo_Click()
Options
End Sub
Private Sub Options()
Select Case True
Case optYes.Value = True
cmb.Enabled = True
cmb.RowSource = "=Options!A1:A4"
Case optNo.Value = True
cmb.Enabled = False
End Select
End Sub
I would like to modify this slightly so that the Combobox list is limited to a group of Checkboxes that have been selected. So if I have 10 checkboxes denoting different options, and the user only selects 4 of them, then only those 4 will appear in the Combobox.
Here's how I would do it:
Private Sub Algeria_Change()
Options
End Sub
Private Sub Bangladesh_Change()
Options
End Sub
Private Sub Canada_Change()
Options
End Sub
Private Sub Denmark_Change()
Options
End Sub
Private Sub Options()
Dim names As Variant, name As Variant
Dim old As String
names = Array("Algeria", "Bangladesh", "Canada", "Denmark")
old = cmb
cmb.Clear
cmb.Enabled = False
For Each name In names
If Me.Controls(name) Then
cmb.AddItem Me.Controls(name).Caption
cmb.Enabled = True
If name = old Then cmb.SelText = old
End If
Next name
End Sub
If you need more checkboxes just add their name to names and call Options when they change.
Related
newbie here; Im trying to migrate my VB program to run in Tabs. so far I have been experimenting with creating Tabs at runtime with added controls. I figured out that I can create tabs and add controls at either FormLoad() or by an execute Button. However, I can not access those controls once the Tab is created. I can not get any info from a combo, text box either outside the created Tab. Here is a simple program that I manage to put together:
Public Class Form1
Inherits Form
Private tabControl1 As TabControl
Private tabPage1 As TabPage
Private tabPage2 As TabPage
Dim nm As String
Private Sub MyTabs()
Me.tabControl1 = New TabControl()
Me.tabPage1 = New TabPage()
Me.tabPage2 = New TabPage()
Dim txtBox1 As New Windows.Forms.TextBox With {.Parent = tabPage1}
Dim CalcButton As New Windows.Forms.Button With {.Parent = tabPage1}
CalcButton.Location = New Point(1572, 150)
CalcButton.Size = New Point(100, 50)
CalcButton.Text = "CALCULATE"
txtBox1.Location = New Point(1572, 258)
txtBox1.Size = New Point(70, 22)
txtBox1.Name = "Loc_num"
txtBox1.Text = "1"
nm = txtBox1.Text
Me.tabControl1.Controls.AddRange(New Control() {Me.tabPage1, Me.tabPage2})
Me.tabControl1.Padding = New Point(15, 10)
Me.tabControl1.Location = New Point(35, 25)
Me.tabControl1.Size = New Size(1800, 750)
' Selects tabPage1 using SelectedTab
Me.tabControl1.SelectedTab = tabPage1
Me.tabPage1.Text = "tabPage1"
Me.tabPage2.Text = "tabPage2"
Me.Size = New Size(2000, 900)
Me.Controls.AddRange(New Control() {Me.tabControl1})
AddHandler CalcButton.Click, AddressOf CalcButton_Click
End Sub
Private Sub CalcButton_Click()
Dim xx As Integer
Me.tabControl1.SelectedTab = tabPage1
xx = Convert.ToInt32(nm) ' IT KEEPS SHOWING A 1, EVENTHOU I CHANGED IT TO 4 WHEN FORM LOADS
MessageBox.Show(nm)
End Sub
Public Sub New()
MyTabs()
End Sub
Public Sub Main()
Application.Run(New Form1())
End Sub
End Class
Im not sure if its possible to continue of this path
Thanks for any help or comment
I saw some answeres here but none of them fitted to me.
I have a form with bounded inputs, which I want the user to be able to edit.
though, when the user changes the fields, and then close the form - even without clicking the "update" button - it changes the data in the database.
is there a way to verify that the data will be changed only when the "update" button is pressed?
thanks
You could do the following:
1) Define a global variable in the form "ButtonPressed" and set it to false when you enter the form or record (e.g. OnCurrent).
2) In Form_BeforeUpdate() put the following code:
If Not ButtonPressed Then Cancel = True
3) In Button_Click() put the following code:
ButtonPressed = True
DoCmd.RunCommand acCmdSaveRecord
4) Reset the ButtonPressed after updating the form in Form_AfterUpdate()
The whole code should look like this:
Option Compare Database
Option Explicit
Dim ButtonPressed As Boolean
Private Sub Button_Click()
ButtonPressed = True
DoCmd.RunCommand acCmdSaveRecord
End Sub
Private Sub Form_AfterUpdate()
ButtonPressed = False
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Not ButtonPressed Then Cancel = True
End Sub
Private Sub Form_Current()
ButtonPressed = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.Undo
End Sub
Private Sub Form_Error(DataErr As Integer, Response As Integer)
If DataErr = 2169 Then
Response = True
End If
End Sub
Within Excel VBA I have a User Form similar to the following where the user enters an ID number and then the details are displayed on the user form:
Private Sub btnIDNo_Click()
Dim IDNo As Long
If txtIDNo.Text <> "" Then
If IsNumeric(txtIDNo.Text) = True Then
lblError.Caption = ""
IDNo = txtIDNo.Text
Worksheets("Details").Activate
Range("B4").Select
While ActiveCell.Value <> "" And ActiveCell.Value <> IDNo
ActiveCell.Offset(1, 0).Select
Wend
If ActiveCell.Value = IDNo Then
txtName.Value = ActiveCell.Offset(0, 1).Value
txtPhone.Value = ActiveCell.Offset(0, 2).Value
Else
lblError.Caption = "Cannot find ID nummber"
End If
Else
lblError.Caption = "Please enter the ID Number in numeric form"
End If
End If
End Sub
On the Details User Form, I have an "Edit" button. Clicking the "Edit" button would open another user form where the user can change the details of that ID number, but obviously not the ID number itself. To do this, I need to pass the ID number from the Details User Form to the Edit User Form. Is there a way of doing this?
The bottom on the Show Details User Form to open the Edit User Form is similar to the following:
Private Sub CommandButton1_Click()
Dim IDNo As Long
If txtIDNo.Text <> "" Then
If IsNumeric(txtIDNo.Text) = True Then
lblError.Caption = ""
IDNo= txtIDNo.Text
ufmEditDetails.Show
ufmShowDetails.Hide
Else
lblError.Caption = "Please enter the ID Number in numeric form"
End If
Range("B4").Select
End If
End Sub
I have already looked at the following links but they don't seem to help:
http://www.mrexcel.com/forum/excel-questions/671964-visual-basic-applications-pass-variables-between-user-forms.html
http://gregmaxey.mvps.org/word_tip_pages/userform_pass_data.html
http://peltiertech.com/Excel/PropertyProcedures.html
There are many many ways... Here are some...
Way 1
Declare a Public Variable in a Module
Assign to that variable in Userform1 and then launch Userform2. This variable will retain it's value. Example
In Userform1
Private Sub CommandButton1_Click()
MyVal = "Sid"
UserForm2.Show
End Sub
In Userform2
Private Sub CommandButton1_Click()
MsgBox MyVal
End Sub
In Module
Public MyVal
Way 2
Use the .Tag property of the userform
In Userform1
Private Sub CommandButton1_Click()
UserForm2.Tag = "Sid"
UserForm2.Show
End Sub
In Userform2
Private Sub CommandButton1_Click()
MsgBox Me.Tag
End Sub
Way 3
Add a Label in Userform2 and set it's visible property to False
In Userform1
Private Sub CommandButton1_Click()
UserForm2.Label1.Caption = "Sid"
UserForm2.Show
End Sub
In Userform2
Private Sub CommandButton1_Click()
MsgBox Label1.Caption
End Sub
There are serveral ways to solve this problem.
The one that I use is declare global or public variable in module
Example:
Public commonVariable As String
then in userform you can assign or retrieve value from this variable.
For example
in userform1:
Private Sub btnIDNo_Click()
commonVariable = "UserId"
End Sub
in UserForm2:
Private Sub CommandButton1_Click()
me.txtIDNo.Text = commonVariable
End Sub
The most simplest way is:
UserForm2.TxtIDNo.Text = UserForm1.txtIDNo.Text
I have more than 40 check-boxes in a single calc sheet, and I don't want to code each one of them. I just want a clear working code to get the name of checkbox.
In this program I have to manually type the name for the check-box within the macro code:
A="CheckBox1"
This is all I have so far:
Sub Marco1
Dim ocheckbox1
Dim oForm
Dim A
A="CheckBox1"
oForm = ThisComponent.Sheets(0).DrawPage.Forms.getByIndex(0)
ocheckbox1 = oForm.getByName(A)
if ocheckbox1.State = "0" then
if MsgBox ("Are you sure ?Note: It can't be re-edited", 292) = 6 then
ocheckbox1.Label = "Checked"
ocheckbox1.Enabled="False"
else
ocheckbox1.Label = "Not Checked"
End if
End if
End Sub
Assuming the macro is triggered by interaction with the checkbox:
Sub Macro1 (oEvent As Object)
Dim oCheckbox1 As Object
Dim sCheckbox1Name As String
oCheckbox1 = oEvent.source.model
sCheckbox1Name = oCheckbox1.Name
End Sub
Well, the title says it all. I have an HTA with a VBS class where I'm trying to call setInterval with another class sub as its "function" argument, but I get an "Type mismatch" error.
Can this be done in any straight or workaround hack form? The only thing I can think of is having the "argument" function outside the Class, but that kind of beats the purpose of the class in the first place...
Help!
Edit (example code):
Class My_Class
Private TimerID
Public Sub Sub1(param)
Dim x
x = DoSomeCalculations(param)
TimerID = window.setInterval("Sub2(x)", 1000, "VBScript")
End Sub
Private Sub Sub2(param)
Dim y
y = DoSomeMoreCalculations
If param = y Then window.clearInterval(TimerID)
End Sub
End Class
Late answer, but... that should work:
Class My_Class
Private TimerID
Public Sub Sub1(param)
Dim x
x = DoSomeCalculations(param)
Dim cb
Set cb = New MyCallback
Set cb.Target = Me
cb.ParamValue = x
TimerID = window.setInterval(cb , 1000, "VBScript")
End Sub
' must be Public
Public Sub Sub2(param)
Dim y
y = DoSomeMoreCalculations
If param = y Then window.clearInterval(TimerID)
End Sub
End Class
Class MyCallback
Public Target
Public ParamValue
' must be Public and Default
Public Default Sub DoCall
Target.Sub2 ParamValue
End Sub
End Class
window.setTimeout and window.setInterval will call Default Sub or Default Function. Unfortunately, it can't be used in event handlers.
Based on this article I thought that setInterval would pass the 'function' string to GetRef(), but it seems to work more like eval:
<html>
<head>
<Title>SetIntervalDemo</Title>
<hta:application id="SetIntervalDemo" scroll = "no">
<script type="text/vbscript">
Dim g_sp0
Sub sp0()
MsgBox "sp0 called"
ClearInterval g_sp0
End Sub
Sub sisp0()
g_sp0 = SetInterval(GetRef("sp0"), 1000)
' g_sp0 = SetInterval("mp0", 1000) <---- Type Mismatch
End Sub
Dim g_sp1
Sub sp1(x)
MsgBox "sp1 called: " & x
ClearInterval g_sp1
End Sub
Sub sisp1()
g_sp1 = SetInterval("sp1(4711 + g_sp1)", 1000)
End Sub
Dim g_mp0_a
Dim g_o_a
Dim g_mp0_b
Dim g_o_b
Sub simp0()
Set g_o_a = New cC : g_o_a.m_sName = "Alpha"
Set g_o_b = New cC : g_o_b.m_sName = "Beta"
g_mp0_a = SetInterval("g_o_a.mp0", 1000)
g_mp0_b = SetInterval("g_o_b.mp0", 1000)
End Sub
Class cC
Public m_sName
Public Sub mp0()
MsgBox m_sName & ".mp0 called"
ClearInterval g_mp0_a
ClearInterval g_mp0_b
End Sub
End Class
</script>
</head>
<body>
<input type="button" value="sp0" onclick="sisp0" />
<input type="button" value="sp1" onclick="sisp1" />
<input type="button" value="mp0" onclick="simp0" />
</body>
</html>
So using Subs, some globals, and method calls ("g_o_a.mp0") may be the way to call a method periodically. (Please test carefully before you use this in production code.)
I don't think it's possible to call a method in the instance itself (i.e. via Me) since the context is lost when you call the timer.
You could use a global variable though (nasty though that is). The issue there is if you have multiple instances of the same class, you'd need a global variable for each instance, and the code would need to know which variable to call.
However, there is a workaround to the above - use an array or a dictionary as a single global object, then use a name or id to identify your instance from that collection.
Now when you use the timer, call a method outside of your class, passing the instance's identifier as a value. The method you call can look up this id in your collection, returning your instance, then can call the relevant method on that instance.
Bit of a hack but it works - have a play with the demo hta app below to see it in action.
Search for the string '!Important to see the key bits of code.
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8" />
<script type="text/vbs" language="vbscript">
option explicit
dim dummies '!Important - this is the global variable holding all your instances
sub CreateDummyInstances()
dim dum
set dummies = CreateObject("Scripting.Dictionary")
set dum = (new Dummy)("Makaveli84", 5000)
set dum = (new Dummy)("JohnLBevan", 7000)
set dum = (new Dummy)("Ekkehard.Horner", 10000)
set dum = nothing
end sub
class Dummy
private m_name
private m_timeoutMilSec
private m_timerOn
private m_timerRunningLock
private sub Class_Initialize
m_timerOn = false
m_timerRunningLock = false
end sub
public default function Dummy(name, timeoutMilSec)
m_name = name
m_timeoutMilSec = timeoutMilSec
dummies.add name, me '!Important - add this new instance to our collection
CreateButton
set Dummy = me
end function
public property Get Name
Name = m_name
end property
public property Get IsTimerOn
IsTimerOn = m_timerOn
end property
public sub BeginTimer()
m_timerOn = true
if not m_timerRunningLock then 'avoid creating two threads if an off-on occurs within a single timer wait
TimerLoop
end if
end sub
public sub EndTimer()
m_timerOn = false
end sub
public sub TimerLoop()
if m_timerOn then 'get out of jail free (altered by separate thread)
m_timerRunningLock = true
PerformSomeAction
'this doesn't work because Me loses its context when called by the timer
'window.setTimeout "Me.TimerLoop", m_timeoutMilSec, "VBScript"
'so instead we pass a name / id for this object as a parameter to an external function
'and have that lookup this instance and externally call the method we wanted to call
window.setTimeout "TheFunkyTrick(""" & m_name & """)", m_timeoutMilSec, "VBScript" '!Important - call the external function
else
m_timerRunningLock = false
end if
end sub
private sub CreateButton()
dim p
dim button
set p = document.createElement("p")
set button = document.createElement("button")
button.id = "btnStart" & m_name
button.innerText = "Start " & m_name
AddClickEventHandler button, "StartTimer"
p.appendChild button
set button = document.createElement("button")
button.id = "btnStop" & m_name
button.innerText = "Stop " & m_name
AddClickEventHandler button, "StopTimer"
p.appendChild button
divButtons.appendChild p
set button = Nothing
set p = Nothing
end sub
private sub AddClickEventHandler(objButton, strFunctionName)
dim fun
set fun = getRef(strFunctionName)
call objButton.attachEvent("onclick", fun)
set fun = Nothing
end sub
sub PerformSomeAction
msgbox "Hello from " & m_name & ". I show up every " & cstr(cint(m_timeoutMilSec/1000)) & " seconds, until stopped."
end sub
end class
function vbInit()
CreateDummyInstances
end function
function GetDummy(name)
if dummies.exists(name) then
set GetDummy = dummies(name) '!Important - get desired instance from the collection (assuming it exists)
else
msgbox "name not found: " & name
set GetDummy = nothing 'the way I've coded stuff below this would cause an exception (i.e. since I've not bothered to check if it's nothing) - but as this is a demo that's fine
end if
end function
function GetNameFromButtonEvent(objEvent, boilerplate)
GetNameFromButtonEvent = Right(objEvent.srcElement.Id, len(objEvent.srcElement.Id) - len(boilerplate))
end function
sub StartTimer(objEvent)
dim name
name = GetNameFromButtonEvent(objEvent, "btnStart")
GetDummy(name).BeginTimer
end sub
sub StopTimer(objEvent)
dim name
name = GetNameFromButtonEvent(objEvent, "btnStop")
GetDummy(name).EndTimer
end sub
sub TheFunkyTrick(name) '!Important - call the method on the relevant instance
GetDummy(name).TimerLoop
end sub
</script>
<HTA:APPLICATION
ApplicationName="Stack Overflow VBScript Class Timer Demo"
Caption="Yes"
icon="img/favicon.ico"
Scroll="no"
SingleInstance="yes"
WindowState="normal"
ShowInTaskbar="Yes"
SysMenu="Yes"
MaximizeButton="No"
ShowInTaskbar="Yes"
MinimizeButton="No"
Navigable="No"
Border="Thin"
BORDERSTYLE="Complex"
INNERBORDER="No"
/>
<title>Stack Overflow VBScript Class Timer Demo</title>
</head>
<body onload="vbInit()" language="vbscript">
<h1>Demo</h1>
<div id="divButtons"></div>
</body>
</html>