I have 3 columns with titles Used and Add and Total.
Condition are;
Used: allows user to input any positive value but stores it in the table filed as a negative value.
Add: allows user to input positive values and stores it in the table field as a positive.
Total: Stores the sum of the fields associated with Used and Add.
This is what I have so far. The Total filed does not work as expected. Any idea?
'Add to database a new value -------------------------
Private Sub Add_AfterUpdate()
If IsNull(Add.Value) Then
Add.Value = 0
ElseIf Add.Value < 0 Then
Add1.Value = -Add.Value
ElseIf Add.Value > 0 Then
Add.Value = Add
End If
Total_AfterUpdate 'To update the Total in textbox--------------
Add_Enter 'To show 0 in the textbox--------------
End Sub
'Substract from databae field a new value from already existing value-------
Private Sub Used_AfterUpdate()
Used.Value = Used
If IsNull(Used.Value) Then
Used.Value = 0
ElseIf Used.Value < 0 Then
Used.Value = -Used.Value
ElseIf Used.Value > 0 Then
Used.Value = Used
End If
Total_AfterUpdate 'To update the Total in textbox--------------
Add_Enter 'To show 0 in the textbox--------------
End Sub
'Total the results based on changes made through the Used textbox or the Add texbox
Private Sub Total_AfterUpdate()
Dim TotalAdd As Double
Dim TotalUsed As Double
TotalAdd = Total.Value + Add
Total = TotalAdd
TotalUsed = Total.Value - Used
Total = TotalUsed
End Sub
Unless I've misunderstood, try something like this:
Private Sub Used_AfterUpdate()
If IsNull(Used) Then
Used = 0
ElseIf Used > 0 Then
Used = -Used
End If
Total_AfterUpdate
End Sub
Private Sub Add_AfterUpdate()
If IsNull(Add) Then
Add = 0
ElseIf Add < 0 Then
Add = -Add
End If
Total_AfterUpdate
End Sub
Private Sub Total_AfterUpdate()
Total = Used + Add
End Sub
EDIT: Alternatively, this may be written:
Private Sub Used_AfterUpdate()
Used = -Abs(Nz(Used, 0))
Total_AfterUpdate
End Sub
Private Sub Add_AfterUpdate()
Add = Abs(Nz(Add, 0))
Total_AfterUpdate
End Sub
Private Sub Total_AfterUpdate()
Total = Used + Add
End Sub
I am trying to execute a Sub after a certain time period after a UserForm has open. The UserForm opens immediately when Access has started. Is there an alternative to Application.OnTime? As it does not work with Access and only seems to work with Excel.
This is what I'm working with.
Private Sub UserForm_Activate()
Set objWSHShell = CreateObject("WScript.Shell")
DesktopDir = objWSHShell.SpecialFolders("Desktop") & "\"
InstallDir = Left(DesktopDir, 3) & "VICI"
VICIMxDir = InstallDir & "\VICI Mx.txt"
VICIFmDir = InstallDir & "\VICI Fm.txt"
VICIAnalyticsDir = InstallDir & "\VICI Analytics.txt"
With ListBox_Status
If FSO.FileExists(VICIMxDir) = True Then 'Both exist
.Column(1, 0) = "Ready"
Else
.Column(1, 0) = "Not Found"
End If
If FSO.FileExists(VICIFmDir) = True Then
.Column(1, 1) = "Ready"
Else
.Column(1, 1) = "Not Found"
End If
If FSO.FileExists(VICIAnalyticsDir) = True Then
.Column(1, 2) = "Ready"
Else
.Column(1, 2) = "Not Found"
End If
.Column(1, 3) = Environ("UserName")
End With
Application.OnTime Now + TimeValue("00:00:10"), "DB_BackUP"
Application.OnTime Now + TimeValue("00:00:20"), "RmvDBBackup"
End Sub
You can use Application.Wait:
Private Sub UserForm_Activate()
waitTime (3000) ' 3 seconds
MyDeleyedMethod
End Sub
Function waitTime(ByVal millsec As Double)
Application.Wait (Now() + millsec / 24 / 60 / 60 / 1000)
End Function
Private Sub MydelayedMethod()
MsgBox ("hello")
End Sub
Another way to achieve that result is:
Private Sub UserForm_Activate()
Wait (3) ' 3 seconds
MyDeleyedMethod
End Sub
Sub Wait(seconds As Integer)
Dim now As Long
now = Timer()
Do
DoEvents
Loop While (Timer < now + seconds)
End Sub
Private Sub MyDeleyedMethod()
MsgBox ("hello")
End Sub
I have one field named "Date_Capture" created on the access form which is available for end user to select the date by using date picker. When user is selecting the date using date picker then only date is coming correct but the correct time is not showing up. for each record time is coming like 11/10/2015 12:00:00 AM, 11//11/2016 12:00:00 AM.I need to show the exact time when we select a particular date using date picker.
is there any work around to fix this? Please let me know.
Thanks,
RR
It is usually faster just to type the time, for example as described here:
Entering 24-hour time with input mask and full validation in Microsoft Access
with full code also here at GitHub.
You can enter dates much the same way:
Entering ISO formatted date with input mask and full validation in Microsoft Access
and code is here at GitHub.
Code:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Form_LogonDate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
Dim DefaultDate As Date
Dim DefaultFormat As String
Dim DefaultInputMask As String
Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim ctl As Control
Dim SelStart As Integer
On Error Resume Next
Set ctl = Screen.ActiveControl
Select Case ctl.Name
Case "Logon"
SelStart = ctl.SelStart
' Clear deleted digits by resetting the input mask.
ctl.InputMask = DefaultInputMask
ctl.SelStart = SelStart
ctl.SelLength = 1
Response = acDataErrContinue
End Select
Set ctl = Nothing
End Sub
Private Sub Form_Load()
Dim InitialDate As Date
' Set initial date.
InitialDate = Date
' Format and length of DefaultFormat and
' first part of DefaultInputMask must match.
DefaultFormat = "yyyy/mm/dd"
DefaultInputMask = "0000/00/00;1;0"
Me!Logon.Format = DefaultFormat
Me!Logon.InputMask = DefaultInputMask
Me!Logon.ShowDatePicker = False
SetDefaultDate InitialDate
End Sub
Private Sub Logon_AfterUpdate()
With Me!Logon
If IsNull(.Value) Then
' Rem this line out to allow the textbox to be cleared.
.Value = DefaultDate
ElseIf .Value < DateSerial(9999, 12, 31) Then
SetDefaultDate DateAdd("d", 1, .Value)
Else
SetDefaultDate .Value
End If
End With
End Sub
Private Sub Logon_Click()
Dim SelStart As Integer
With Me!Logon
If .SelStart = 4 Or .SelStart = 7 Then
' Move the cursor off the separator (slash)
' to the first digit of months or days.
.SelStart = .SelStart + 1
End If
SelStart = .SelStart
.SelStart = SelStart
.SelLength = 1
End With
End Sub
Private Sub Logon_Enter()
With Me!Logon
If IsNull(.Value) Then
.Value = DefaultDate
End If
End With
End Sub
Private Sub Logon_KeyPress(KeyAscii As Integer)
Dim Text As String
Dim Length As Integer
Dim SelStart As Integer
With Me!Logon
Select Case KeyAscii
Case vbKeyBack, vbKeyTab, Asc(vbLf), vbKeyReturn, vbKeyEscape, vbKeyF16
' Allow navigation etc. with
' BackSpace, Tab, Ctrl+Enter, Enter, Escape, Ctrl+BackSpace
Case Is > 0
Text = .Text
Length = Len(Text)
SelStart = .SelStart
If KeyAscii < vbKey0 Or KeyAscii > vbKey9 Then
' Replace any invalid entry with a zero.
KeyAscii = vbKey0
End If
If SelStart < Length Then
Select Case SelStart
' Year part.
Case Is = 0
' First digit of year.
If KeyAscii = vbKey0 Then
' No year before 1000.
KeyAscii = vbKey1
End If
' Month part.
Case Is = 5
' First digit of month.
If KeyAscii > vbKey1 Then
' No month with tens beyond 1.
KeyAscii = vbKey1
End If
Case Is = 6
' Second digit of month.
Select Case Val(Mid(.Text, 6, 1))
Case Is = 0
' Month is < 10.
If KeyAscii = vbKey0 Then
' Month cannot be 00.
KeyAscii = vbKey1
End If
Case Is > 0
' Month is 10+.
If KeyAscii > vbKey2 Then
' No month beyond 12.
KeyAscii = vbKey2
End If
End Select
' Day part.
Case Is = 8
' First digit of day.
Select Case Val(Mid(.Text, 6, 2))
Case Is = 2
' Month is February.
If KeyAscii > vbKey2 Then
' No day with tens beyond 2 for February.
KeyAscii = vbKey2
End If
Case Else
If KeyAscii > vbKey3 Then
' No day with tens beyond 3.
KeyAscii = vbKey3
End If
End Select
Case Is = 9
' Second digit of day.
Select Case Mid(.Text, 9, 1)
Case Is = 3
' Days of 30.
Select Case Val(Mid(.Text, 6, 2))
Case 1, 3, 5, 7, 8, 10, 12
If KeyAscii > vbKey1 Then
' No day beyond 31.
KeyAscii = vbKey1
End If
Case 4, 6, 9, 11
If KeyAscii > vbKey0 Then
' No day beyond 30.
KeyAscii = vbKey0
End If
End Select
Case Is = 2
' Days of 20.
Select Case Val(Mid(.Text, 6, 2))
Case 2
If KeyAscii = vbKey9 Then
' Check for leap year.
If Month(DateAdd("d", 1, DateSerial(Val(Mid(.Text, 1, 4)), 2, 28))) = 3 Then
' Not a leap year.
KeyAscii = vbKey8
End If
End If
End Select
Case Is = 0
' Days of 00.
If KeyAscii = vbKey0 Then
' No day of 00.
KeyAscii = vbKey1
End If
End Select
End Select
End If
End Select
End With
End Sub
Private Sub SetDefaultDate(ThisDate As Date)
DefaultDate = ThisDate
Me!Logon.DefaultValue = Format(ThisDate, "\#yyyy\/mm\/dd\#")
End Sub
and:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Form_Logon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
Dim DefaultTime As Date
Private Sub Form_Error(DataErr As Integer, Response As Integer)
Const TimeHourMaximum As Integer = 24
Const TimeHourDefault As Integer = 20
Const TimeMinuteTenMax As Integer = 5
Dim ctl As Control
Dim Text As String
Dim SelStart As Integer
On Error Resume Next
Set ctl = Screen.ActiveControl
Select Case ctl.Name
Case "Logon"
Text = ctl.Text
SelStart = ctl.SelStart
If Not IsDate(Text) Then
DoCmd.Beep
If Val(Left(Text, 2)) > TimeHourMaximum Then
Mid(Text, 1) = CStr(TimeHourDefault)
ElseIf Len(Text) > 3 Then
' Length of Text is larger than two hour digits and the kolon.
Mid(Text, 1 + 3) = CStr(TimeMinuteTenMax)
End If
End If
ctl.Text = Text
ctl.SelStart = SelStart
ctl.SelLength = 1
Response = acDataErrContinue
End Select
Set ctl = Nothing
End Sub
Private Sub Form_Load()
Const InitialTime As Date = #6:00:00 AM#
Me!Logon.ShowDatePicker = False
Me!Logon.InputMask = "90:00;1;0"
Me!Logon.Format = "hh:nn"
SetDefaultTime InitialTime
End Sub
Private Sub Logon_AfterUpdate()
With Me!Logon
If IsNull(.Value) Then
' Rem this line out to allow the textbox to be cleared.
.Value = #12:00:00 AM#
Else
SetDefaultTime DateAdd("n", 1, .Value)
End If
End With
End Sub
Private Sub Logon_Click()
With Me!Logon
If .SelStart = 2 Then
' Move the cursor off the separator (colon)
' to the first digit of minutes.
.SelStart = 3
.SelLength = 1
End If
End With
End Sub
Private Sub Logon_Enter()
With Me!Logon
If IsNull(.Value) Then
.Value = DefaultTime
End If
End With
End Sub
Private Sub Logon_KeyPress(KeyAscii As Integer)
Dim Text As String
Dim Char As String
Dim Length As Integer
Dim SelStart As Integer
With Me!Logon
Select Case KeyAscii
Case vbKeyBack, vbKeyTab, Asc(vbLf), vbKeyReturn, vbKeyEscape, vbKeyF16
' Allow navigation etc. with
' BackSpace, Tab, Ctrl+Enter, Enter, Escape, Ctrl+BackSpace
Case Is > 0
Text = .Text
Length = Len(Text)
SelStart = .SelStart
If KeyAscii < vbKey0 Or KeyAscii > vbKey9 Then
' Replace any invalid entry with a zero.
KeyAscii = vbKey0
End If
Char = Mid(Text, 1 + SelStart, 1)
If SelStart < Length Then
If KeyAscii <= vbKey0 + 2 Then
' Always accept 0, 1, 2.
Else
' Check if the text will represent a valid time.
' If not, restore the overwritten digit.
Mid(Text, 1 + SelStart, 1) = Chr(KeyAscii)
If Not IsDate(Text) Then
DoCmd.Beep
KeyAscii = Asc(Char)
End If
End If
End If
End Select
End With
End Sub
Private Sub SetDefaultTime(ThisTime As Date)
DefaultTime = ThisTime
Me!Logon.DefaultValue = Format(ThisTime, "\#hh:nn:00 AM/PM\#")
End Sub
In response to Thomas G and RRO, put this code into the Code Builder for one of the Date fields, After Update Function.
Dim X As String
X = Format (Now(), "hh:mm:ss")
Me!YourFieldName.Value = X
I'm writing code in access vba for the list box items to move up and down. Needs to use .List Property in access . But it throws an error says no method or member found. Any replace method with .List ? Researching on this more than 4 days.
Private Sub cmdUP_Click()
Dim i As Long
Dim leaveAlone As Boolean
Dim pos As Long
Dim Temp As String
pos = 0
With Me.lbfNames
For i = 0 To .ListCount - 1
leaveAlone = False
If .Selected(i) Then
If i = pos Then
leaveAlone = True
End If
pos = pos + 1
If leaveAlone = False Then
Temp = .RowSource(i - 1)
.RowSource(i - 1) = .RowSource(i) ' before i used .List instead of rowsource
.RowSource(i) = Temp
.ListIndex = i - 1
.Selected(i) = False
.Selected(i - 1) = True
End If
End If
Next
End With
I've figured that out, how to do it in access. But set list box Multiselect property to 'None'.
Moving Down
Private Sub cmdDown_Click()
Dim sText As String
Dim iIndex As Integer
Dim bottomLimit As Integer
iIndex = lbfNames.ListIndex
bottomLimit = lbfNames.ListCount - 1
'check: only proceed if there is a selected item
If lbfNames.ListCount > 1 Then
If iIndex >= bottomLimit Then
MsgBox ("Can not move the item down any further.")
Exit Sub
End If
'save items text and items indexvalue
sText = lbfNames.Column(0, iIndex)
If iIndex < bottomLimit Then
lbfNames.RemoveItem iIndex
'place item back in new position
lbfNames.AddItem sText, iIndex + 1
End If
'if you keep that item selected
'you can keep moving it by pressing btnMoveDown
lbfNames.Selected(iIndex + 1) = True
iIndex = iIndex + 1
End If
End Sub
Moving up
Private Sub cmdUP_Click()
Dim sText As String
Dim iIndex As Integer
iIndex = lbfNames.ListIndex
' ReDim iIndex(0 To 10)
'check: only proceed if there is a selected item
If lbfNames.ListCount > 1 Then
'index 0 is top item which can't be moved up!
If iIndex <= 0 Then
MsgBox ("Can not move the item up any higher.")
Exit Sub
End If
' If iIndex = -1 Or lbfNames.ListCount > 1 Then
'save items text and items indexvalue
sText = lbfNames.Column(0, iIndex)
lbfNames.RemoveItem iIndex
'place item back on new position
lbfNames.AddItem sText, iIndex - 1
'if you keep that item selected
'you can keep moving it by pressing cmdUp
lbfNames.Selected(iIndex - 1) = True
iIndex = iIndex - 1
End If
End Sub
Short Answer: No, MS Access VBA doesn't have ListBox.List(row, column) but instead it has ListBox.AddItem(Item, Index) and ListBox.RemoveItem(Index)
For Multi-Column ListBoxes semi-colon character ';' could be used to separate column items i.e. myMultiColListBox.AddItem("Col_1_item;Col_2_item;Col_3_item")
i wanna test pass by reference and pass by value in access, but it doesn't work.
Sub passByRef(ByRef a As Integer)
a = a + 1
End Sub
Sub passByVal(ByVal a As Integer)
a = a + 1
End Sub
Private Sub cmdByRef()
Dim i as Integer
i = 10
passByRef i
MsgBox i
End Sub
Private Sub cmdByVal()
Dim i as Integer
i = 10
passByVal i
MsgBox i
End Sub
in the pass by ref it does not state that it is the pass by reference function. Any idea?
maybe you should do this.
Private Sub cmdByRef()
Dim i as Integer
i = 10
passByRef i
MsgBox "Result of passByRef " + i
End Sub
Private Sub cmdByVal()
Dim i as Integer
i = 10
passByVal i
MsgBox "Result of passByVal " + i
End Sub