Hi to give some context the code below is from an Access database that was left to me from the previous employee, Unfortunately I am not very good at VBA.
I would appreciate any help in identifying its purpose.
Private Sub Command83_Click()
On Error GoTo Err_Command83_Click
Dim stDialStr As String
Dim PrevCtl As Control
Const ERR_OBJNOTEXIST = 2467
Const ERR_OBJNOTSET = 91
Const ERR_CANTMOVE = 2483
Set PrevCtl = Screen.PreviousControl
If TypeOf PrevCtl Is TextBox Then
stDialStr = IIf(VarType(PrevCtl) > V_NULL, PrevCtl, "")
ElseIf TypeOf PrevCtl Is ListBox Then
stDialStr = IIf(VarType(PrevCtl) > V_NULL, PrevCtl, "")
ElseIf TypeOf PrevCtl Is ComboBox Then
stDialStr = IIf(VarType(PrevCtl) > V_NULL, PrevCtl, "")
Else
stDialStr = ""
End If
Application.Run "utility.wlib_AutoDial", stDialStr
Exit_Command83_Click:
Exit Sub
Err_Command83_Click:
If (Err = ERR_OBJNOTEXIST) Or (Err = ERR_OBJNOTSET) Or (Err = ERR_CANTMOVE) Then
Resume Next
End If
MsgBox Err.Description
Resume Exit_Command83_Click
End Sub
Const ERR_... are Error Codes
The script checks whether PrevCtl is a Text-, List or ComboBox and sets the string of stDialStr depending on the Box. In the end it starts an external AutoDial program with the given parameter.
Application.Run "utility.wlib_AutoDial", stDialStr
Related
In access using VB my code is:
Private Sub Form_Timer()
Static OldcontrolName As String
Static OldFormName As String
Static ExpiredTime
Dim ActivecontrolName As String
Dim ActiveFormName As String
Dim ExpiredMinutes
On Error Resume Next
ActivecontrolName = Screen.ActiveControl.Name
ActiveFormName = Screen.ActiveForm.Name
If (OldcontrolName = "") Or (OldFormName = "") Or (ActiveFormName <> OldFormName) Or
(ActivecontrolName <> OldcontrolName) Then
OldcontrolName = ActivecontrolName
OldFormName = ActiveFormName
ExpiredTime = 0
Else
ExpiredTime = ExpiredTime + Me.TimerInterval
End If
ExpiredMinutes = (ExpiredTime / 1000)
If ExpiredMinutes >= 600 Then
ExpiredTime = 0
Application.Quit acQuitSaveAll
End If
End Sub
This seems to work great. I can put the time down to 5 seconds to test and it's perfect but as soon as I turn off the navigation pane and then try to close access it throws the error:
Run-time error '5':
Invalid procedure call or argument
Private Sub Dutybox_Change()
Dim Val As String
ThisWorkbook.Worksheets("User Dashboard").Range("L17").Value = Me.Dutybox.Value
Calculate
If Me.ComboBox18.RowSource <> "" And Me.RankCombo.Value <> "" And Me.Exambox.Value <> "" And Me.Dutybox.Value <> "" Then
Me.ComboBox18.RowSource = "=Rate"
Else
MsgBox "Please Select all the above values"
End If
End Sub
So the IF parts are all filled, and it should fill ComboBox18 with =Rate (a named range) but it keeps popping up the Msgbox
Item 1
Private Sub ComboBox18_Change()
Dim Val As String
ThisWorkbook.Worksheets("User Dashboard").Range("L18").Value = Me.ComboBox18.Value
End Sub
Item 2
Private Sub RankCombo_Change()
ThisWorkbook.Worksheets("User Dashboard").Range("L15").Value = Me.RankCombo.Value
End Sub
Item 3
Private Sub Exambox_Change()
Dim Val As String
ThisWorkbook.Worksheets("User Dashboard").Range("L16").Value = Me.Exambox.Value
End Sub
Code to push range to ComboBox18
Private Sub ComboBox18_Intialize()
MsgBox "combo box"
Me.ComboBox18.List = Application.Transpose(Names("Rate").RefersToRange.Value)
End Sub
I can't figure out why Msgbox is populating when the values are satisified.
Thank you in advance
One way to debug this program is to verify the output in Immediate window,
Please break your code at
If Me.ComboBox18.RowSource <> "" And Me.RankCombo.Value <> "" And Me.Exambox.Value <> "" And Me.Dutybox.Value <> "" Then
On immediate window type the following and press enter to verify the conditions
?Me.ComboBox18.RowSource <> ""
?Me.RankCombo.Value <> ""
?Me.Exambox.Value <> ""
?Me.Dutybox.Value <> ""
all the above four condition should return true.
I suspect that your expressions might not properly handle Null values.
Try using Nz() like this: Nz(Me.RankCombo.Value,"") <> ""
You can also add code to check your assessments:
Debug.Print "Combo18", Me.ComboBox18.RowSource <> ""
Debug.Print "Rank", Me.RankCombo.Value <> ""
In the code I am posting, I am using a check box called "ACDS Test" and whenever it is checked it creates a sheet, then when it becomes unchecked it calls the upper function and deletes the sheet.
I am trying to add a message box that essentially works like a fail safe to ensure they want to delete the page. If they say they do not want to delete the page then I want the checkbox to stay checked.
For some reason I am getting this error message when I try to pass the value to make sure the checkbox stays checked and I cannot figure out why.
The error comes up on the line:
Sub ACDSTest_Click(CorrectValue As Integer)
And the specific error is: "Compile error: Procedure Declaration does not match description of event or procedure having the same name".
Any help is much appreciated! IF any more clarification is needed please feel free to ask!
Sub DeleteWorksheet(NameSheet As String)
Dim Ans As Long
Dim t As String
Dim CorrectValue As Integer
Dim i As Long, k As Long
k = Sheets.Count
Ans = MsgBox("Would you like to take this test off of the form?", vbYesNo)
Select Case Ans
Case vbYes
'Code reads through each page and finds one with corresponding name to string t
'Once it finds the correct page, it deletes it
For i = k To 1 Step -1
t = Sheets(i).Name
If t = NameSheet Then
Sheets(i).Delete
End If
Next i
CorrectValue = 0
Case vbNo
CorrectValue = 1
End Select
End Sub
Sub ACDSTest_Click(CorrectValue As Integer)
Dim NameSheet As String
Dim NameValue As String
NameSheet = "ACDS"
NameValue = "ACDS Test"
If ACDSTest.Value = True Then
CreateWorksheet (NameSheet), (NameValue)
Worksheets("Sheet1").Activate
Else
DeleteWorksheet (NameSheet)
If CorrectValue = 1 Then
ActiveSheet.Shapes("ACDS Test").ControlFormat.Value = 1
End If
End If
End Sub
The issue here is that the CorrectValue variable as you define it in DeleteWorksheet does not exist in the context of the
variable does not exist in context of the ACDSTest_Click subroutine. This is because variables defined within subroutines or functions are local to those functions. To correct this I would convert DeleteWorksheet to a function such as the below.
Further, the event that fires Private Sub ACDSTest_Click() cannot handle passing a value to that function, so changing it to Sub ACDSTest_Click(CorrectValue As Integer) causes an error.
Function DeleteWorksheet(ByVal SheetName As String) As Boolean
On Error GoTo SheetDNE
SheetName = Sheets(SheetName).Name 'Check if sheet exists w/o other objects
On Error GoTo 0
Select Case MsgBox("Would you like to take this test off of the form?", vbYesNo)
Case vbYes
Application.DisplayAlerts = False
Sheets(SheetName).Delete
Application.DisplayAlerts = True
DeleteWorksheet = True
Case Else: DeleteWorksheet = False
End Select
Exit Function 'Exit The Function w/o error
SheetDNE: 'Sheet Does Not Exist
MsgBox "The indicated sheet, " & SheetName & ", does not exist", vbOKOnly
End Function
And
Private Sub ACDSTest_Click()
Dim NameSheet As String
Dim NameValue As String
NameSheet = "ACDS"
NameValue = "ACDS Test"
If ACDSTest.Value = True Then
CreateWorksheet (NameSheet), (NameValue)
Worksheets("Sheet1").Activate
Else
If Not DeleteWorksheet(NameSheet) Then _
ActiveSheet.Shapes("ACDS Test").ControlFormat.Value = 1
End If
End Sub
I'm rewriting some code and had a thought, but can't seem to get my syntax right to execute it properly. I want to use a for loop to populate an array of commandbuttons as well as control their visibility. I just need help with my syntax to define which CommandButton number I'm working on in the loop. For instance, CommandButton1, CommandButton2, etc.
Public Sub LoadLots(sName As String, streamLots() As String)
Label1.Caption = sName
For o = 1 To 9
If streamLots(o) <> "" Then
CommandButton& o &.Caption = streamLots(o)
CommandButton& o & .Visable = True
Else
CommandButton& o & .Visable = False
End If
Next
End Sub
Use the Userform.Controls collection to reference the commandbuttons by name.
Public Sub LoadLots(sName As String, streamLots() As String)
Dim btn As MSForms.CommandButton
Label1.Caption = sName
For o = 1 To 9
Set btn = Me.Controls("CommandButton" & o)
If streamLots(o) <> "" Then
btn.Caption = streamLots(o)
btn.Visible = True
Else
btn.Visible = False
End If
Next
End Sub
I have a UserForm that has one ComboBox and a TextBox. The TextBox needs to do a vlookup for the value of the ComboBox but ONLY if that value exists in the list, if not, I want nothing to appear in the TextBox so the user can enter new information.
This is how far I have got:
Private Sub TextBox1_Enter()
If cbocolor.Value <> "" Then
Dim evalStr As String
Dim check As Variant
evalStr = WorksheetFunction.VLookup(cbocolor.Value, worksheets("CONTACTS").Range("allcontacts"), 2, False)
check = Evaluate(evalStr)
If VarType(check) = vbError Then
TextBox1.Value = "Enter new info"
Else
var1 = WorksheetFunction.VLookup(cbocolor.Value, Worksheets("CONTACTS").Range("allcontacts"), 2, False)
TextBox1.Value = var1
End If
You should be able to do it all with one line:
Private Sub TextBox1_Enter()
If cbocolor.value <> "" Then
TextBox1.value = WorksheetFunction.IfError(Application.VLookup(cbocolor.value, _
Worksheets("CONTACTS").Range("allcontacts"), 2, False), "Enter New Info")
End If
End Sub