I have this class module inside my Access database:
Option Compare Database
Public Event BeforeCalc()
Public Sub Calculate(ByVal i As Integer, ByVal y As Integer)
RaiseEvent BeforeCalc
Calculate = i + y
End Sub
Private Sub Class_Initialize()
Debug.Print "Inside construcotr"
End Sub
Then, inside a custom form:
Option Compare Database
Private WithEvents math As MyMath
Private Sub btnCalculate_Click()
Dim result As Integer
Set result = math.Calculate(CInt(txtI.Text), CInt(txtY.Text))
End Sub
Private Sub Form_Load()
Set math = New MyMath
End Sub
Private Sub math_BeforeCalc()
MsgBox "About to Calc!", vbInformation
End Sub
When I click the form button btnCalculate I got this error at math.Calculate:
"Compile error. Expected function or variable."
What's wrong with my code?
Since it is a function so it should return something, in your case an integer and also you should specify the Function keyword.
replace the code :
Public Sub Calculate(ByVal i As Integer, ByVal y As Integer)
RaiseEvent BeforeCalc
Calculate = i + y
End Sub
with :
Public Function Calculate(ByVal i As Integer, ByVal y As Integer) as Integer
RaiseEvent BeforeCalc
Calculate = i + y
End Sub
You have defined Calculate as a Sub, try defining it as a Function:
Public Function Calculate(ByVal i As Integer, ByVal y As Integer) as Integer
RaiseEvent BeforeCalc
Calculate = i + y
End Function
Also, don't set the result:
Private Sub btnCalculate_Click()
Dim result As Integer
result = math.Calculate(CInt(txtI.Text), CInt(txtY.Text))
End Sub
Related
I designed code for a GUI grade Calculator but now I am being asked to add 1. create a function that will contain all of your data validation code. The function should return true if all data checks have passed or a false if any of the data is invalid. If the data is valid (true returned), add the number to the list box, if it is not valid (false returned), show an error message.2)Add a Sub procedure that will reset the form fields back to their initial state. Call this sub procedure when the clear button is clicked.
2.add a Sub procedure that will reset the form fields back to their initial state. Call this sub procedure when the clear button is clicked.
create a function that will count the 90s in the listbox. Pass the listbox in a a parameter and loop the contents to count each of the 90s in the listbox. Return the count of the 90s in the list box to the caller. Use it as input in the re-write eligibility check.
This is my Code.
Public Class Form1
Private Sub BuGrade_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BuGrade.Click
gradeList.Items.Add(txtgrade.Text)
txtgrade.Clear()
End Sub
Private Sub BuAverage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BuAverage.Click
Dim total As Double
Dim avg As Double
Dim grade As Double
Dim gradecount As Integer
For gradecount = 0 To gradeList.Items.Count - 1
grade = gradeList.Items(gradecount)
total += grade
Next
avg = total / gradeList.Items.Count
lblR.Text = "The final total score is " & total & vbCrLf & "The Average score is " & avg
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
lblR.Text = String.Empty
End Sub
End Class
Is there a way to add an event handler for a control at runtime?
Regard this code (in the form I have only TextBox1):
Option Compare Database
Option Explicit
Dim WithEvents tb As Access.TextBox
Private Sub Form_Load()
set tb = TextBox1
End Sub
Private Sub tb_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print "tb_MouseDown"
End Sub
Private Sub TextBox1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print "TextBox1_MouseDown"
End Sub
With that code, the two handlers are called.
If I remove the handler TextBox1_MouseDown, the tb_MouseDown is not fired.
I have some controls in MS Access form that change the system language to Turkish, Arabic and English and I want to change the system language to English when I go to VBA to write some code.
I have a code that change system language and want to know
How to run this code automatically when I activate VBA editor?
If you put the following code on start of your application, it would run automatically Test2, whenever you press Alt+F11.
Private Sub Workbook_Open()
Application.OnKey "%{F11}", "Test2"
End Sub
Public Sub Test2()
Debug.Print "tested"
End Sub
I am not sure whether this is exactly what you want, but it is a work around to achieve it.
Edit:
Actually, here you may find plenty of useful stuff:
http://www.mrexcel.com/forum/excel-questions/468063-determine-language-user.html
E.g. With the Sub ShowLanguages you may built a function telling you which language are you using and if it is not English, you may switch to it, the way you do it in your answer. I would probably built something similar later.
Private Const LOCALE_ILANGUAGE As Long = &H1
Private Const LOCALE_SCOUNTRY As Long = &H6
Private Declare Function GetKeyboardLayout Lib "user32" _
(ByVal dwLayout As Long) As Long
Private Declare Function GetLocaleInfo Lib "kernel32" _
Alias "GetLocaleInfoA" _
(ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long
Public Sub ShowLangauges()
Dim hKeyboardID As Long
Dim LCID As Long
hKeyboardID = GetKeyboardLayout(0&)
If hKeyboardID > 0 Then
LCID = LoWord(hKeyboardID)
Debug.Print GetUserLocaleInfo(LCID, LOCALE_ILANGUAGE)
Debug.Print GetUserLocaleInfo(LCID, LOCALE_SCOUNTRY)
End If
End Sub
Private Function LoWord(wParam As Long) As Integer
If wParam And &H8000& Then
LoWord = &H8000& Or (wParam And &H7FFF&)
Else
LoWord = wParam And &HFFFF&
End If
End Function
Public Function GetUserLocaleInfo(ByVal dwLocaleID As Long, _
ByVal dwLCType As Long) As String
Dim sReturn As String
Dim nSize As Long
nSize = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
If nSize > 0 Then
sReturn = Space$(nSize)
nSize = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
If nSize > 0 Then
GetUserLocaleInfo = Left$(sReturn, nSize - 1)
End If
End If
End Function
I use Timer to check if VBA editor window is the active window every 0.5 Sec and if true I run my function that change the language to English and stop Timer:
Private Sub Form_Timer()
Dim st As String
On Error Resume Next
st = VBE.ActiveWindow.Caption
If Err = 0 Then
ChLng 1033
Me.TimerInterval = 0
End If
On Error GoTo 0
End Sub
And I run Timer again when any control on my form change the language to non English language:
Private Sub cmbAR_GotFocus()
ChLng 1025
Me.TimerInterval = 500
End Sub
Private Sub cmbTR_GotFocus()
ChLng 1055
Me.TimerInterval = 500
End Sub
In Form design I manually add all needed events including Form Load event that run the Timer:
Private Sub Form_Load()
Me.TimerInterval = 500
End Sub
NOTE: ChLng xxxx is the function that change the language:
(Find your desired language at BCP 47 Code)
Private Declare Function ActivateKeyboardLayout Lib _
"user32.dll" (ByVal myLanguage As Long, Flag As Boolean) As Long
'define your desired keyboardlanguage
Sub ChLng(lng As Long)
ActivateKeyboardLayout lng, 0
End Sub
I'm using List(Of T) to contains my database field (invoice_id and item_id) and want to display it in DataGridView. First, I declare each of them as a class and then add them to my list then display it in DataGridView but when I compile it, the program is not responding.
My guess is that my database source is too large, because when I change the source (database field), it worked nicely. So how do I solve this List(Of T) capacity issues?
This is my code:
Sub view()
Dim msql2 As String
msql2 = "select invoice_id, item_id from detail"
Dim arayD As New List(Of INVOICE)
CMD2 = New MySqlCommand(msql2, conn.konek)
Try
Dim res = CMD2.ExecuteReader()
Dim INVO As INVOICE = Nothing
While res.Read()
INVO = New INVOICE
With INVO
.invoice_id = hasil2.GetString("invoice_id")
.item_id = hasil2.GetString("item_id")
End With
arayD.Add(INVO)
End While
dgv.DataSource = arayD
Catch ex As Exception
MessageBox.Show("ERROR")
End Try
End Sub
Public Class INVOICE
Private _kodeF As Integer
Public Property invoice_id() As Integer
Get
Return _kodeF
End Get
Set(ByVal value As Integer)
_kodeF = value
End Set
End Property
Private _kodeBrg As String
Public Property item_id() As String
Get
Return _kodeBrg
End Get
Set(ByVal value As String)
_kodeBrg = value
End Set
End Property
End Class
if you want a fast solution then add the following line inside your While Loop :
While res.Read()
Application.DoEvents()
...
End While
Or use a BackgroundWorker as the following:
Private WithEvents bgWorker As New System.ComponentModel.BackgroundWorker
Private arayD As New List(Of INVOICE)
Sub view()
bgWorker.RunWorkerAsync()
End Sub
Private Sub bgWorker_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles bgWorker.DoWork
Dim dReader As DataReader
Using YourConnection
Using YourCommand
YourConnection.Open()
dReader = YourCommand.ExecuteReader()
If dReader.HasRows Then
While dReader.Read
arayD.Add(New INVOICE With {
.invoice_id = hasil2.GetString("invoice_id"),
.item_id = hasil2.GetString("item_id")
}
)
End While
End If
End Using
End Using
End Sub
Private Sub bgWorker_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles bgWorker.RunWorkerCompleted
MsgBox("Ready to go")
dgv.DataSource = arayD
End Sub
Also you can get the count of the result and use it with a progressbar.
Can anyone explain to me why, in VBA code for a button on a form in MS-Access 2007, this gives the error "Compile error: Type mismatch: array or user-defined type expected"
Private Sub Button_Click()
Dim Arr() As Integer
Foo (Arr())
End Sub
Private Sub Foo(Arr() As Integer)
Me.Field.Value = "Foo"
End Sub
but this compiles fine?
Private Sub Button_Click()
Dim Dummy
Dim Arr() As Integer
Dummy = Bar (Arr())
End Sub
Private Function Bar(Arr() As Integer)
Me.Field.Value = "Bar"
End Function
The function/subroutine I'm writing doesn't return anything, but I can't get it to compile unless I assign the return value of my function call to a dummy variable, like in the Bar function above.
If you wish to use brackets around the parameter, you must use Call, so skip the brackets:
Private Sub Button_Click()
Dim Arr() As Integer
''No brackets
Foo Arr()
''Or
''Call Foo(Arr())
End Sub
Private Sub Foo(Arr() As Integer)
Me.Field.Value = "Foo"
End Sub