Using a swear word filter with InStr in Visual Basic 2012 - vba

I want to compare the IF argument to a string array. The user will try to put in a teamname into a textbox, if the user uses a swear word anywhere within that textbox, it will display an error message and clear the textbox. If the user has not sworn, it will register the teamname and carry on with the program (As can be seen in the 2nd IF statement). I have tried to get this code to work for a week now and cannot get it to work.
Private Sub SelectionButtonEnter_Click(sender As Object, e As EventArgs) Handles SelectionButtonEnter.Click
Dim HasSworn As Boolean = False
Dim swears() As String = {"Fuck", "fuck", "Shit", "shit", "Shite", "shite", "Dick", "dick", "Pussy", "pussy", "Piss", "piss", "Vagina", "vagina", "Faggot", "faggot"} 'Declare potential swear words the kids can use
For Each swear As String In swears
If InStr(SelectionTextBoxTeamName.Text, swear) > 0 Then
SelectionTextBoxTeamName.Clear() 'Clear the textbox
MessageBox.Show("Remember ... You can be disqualified, raise your hand and Blair will set up the program for you again") 'Let the user know they have entered a swear word and ask them to select another team name
End If
If Not InStr(SelectionTextBoxTeamName.Text, swear) > 0 Then
Timer1.Enabled = True 'Enable timer 1 for the learn box
Timer3ForSelection.Enabled = True 'Enable this timer to show the learn button
TeamName = SelectionTextBoxTeamName.Text() 'Once this button has been pressed, store the content of that textbox in a the TeamName string
SelectionLabelTeamName.Text = "Welcome " & SelectionTextBoxTeamName.Text & " Please click 'Learn' in the box below to begin" 'Display the contents of the string along with other text here
SelectionLabelTeamNameTL.Text() = "Team Name: " & TeamName 'Display the contents of the string along with other text here
SelectionTextBoxTeamName.BackColor = Color.Green 'Have the back color of the box set to green
SelectionTextBoxTeamName.Enabled = False 'Do not allow the user/users enter another team name
End If
Next 'A next must be declared in a for each statement
End Sub
Thanks in advance.

I don't think I'd approach it that way; if the user types f**kyou, your code wouldn't catch it. How about this instead:
In your code:
If ContainsBannedWord(SelectionTextBoxTeamName.Text) Then
Msgbox "Hold out your hand, bad person. SlapSlapSlap"
Else
Msgbox "Good boy!"
End if
Function ContainsBannedWord(sInput As String) As Boolean
Dim aBannedWords(1 To 5) As String
Dim x As Long
' Make all the banned words capitalized
aBannedWords(1) = "BANNED1"
aBannedWords(2) = "BANNED2"
aBannedWords(3) = "BANNED3"
aBannedWords(4) = "BANNED4"
aBannedWords(5) = "BANNED5"
For x = LBound(aBannedWords) To UBound(aBannedWords)
If InStr(UCase(sInput), aBannedWords(x)) > 0 Then
ContainsBannedWord = True
Exit Function
End If
Next
ContainsBannedWord = False
End Function

Related

Checking and Unchecking Checkboxes in Access

I have a form in MS Access with multiple checkboxes which I want to use to fill up one textbox. If one of the checkboxes gets unchecked, I want its value to be deleted from the textbox without deleting other values. I'm new at using Access and coding in VBA (been reading ebooks for the past 3 weeks) and although I've tried to do research online it's been difficult for me to find the right code.
This is what I have so far:
First code found
Private Sub cb_click()
If Me.cb1 = True Then
Me.txtComentarios.Value = "INACTIVO;"
Else
Me.txtComentarios.Value = Null
End If
End Sub
Second code found
Private Sub cb2_Click()
If Me.cb2 = -1 Then
Me.[txtComentarios] = [txtComentarios] & "DISCREPANCIA"
Else
Me.[txtComentarios] = ""
End If
Exit Sub
End Sub
Also I would like for the checkboxes to fill the textbox in the same order the chechboxes are displayed.
Ex.
cb1; cb2; cb3
If, cb2 gets unchecked and its value gets deleted, I should have "cb1; cb3" but if I re-check cb2 I should get "cb1; cb2; cb3" again.
I just hope someone could guide me in. Thank you in advance.
Luz
You don't need events for each checkbox. Just create one procedure, which creates full text depending on checkboxes state and puts this text to the textbox. To call this function after each click on checkbox set After Update property of all checkboxes to =MyFunctionToUpdateTextbox instead of [Event Procedure]
Private Function MyFunctionToUpdateTextbox()
Dim strText As String
If Me.cb1 = True Then
strText = strText & "INACTIVO;"
End If
If Me.cb2 = True Then
strText = strText & "DISCREPANCIA;"
End If
If Me.cb3 = True Then
strText = strText & "Text for cb3"
End If
Me.txtComentarios = strText
End Function

Is it possible to create an 'input box' in VBA that can take a text selection with multiple lines as an input?

I am trying to create a macro that will filter out relevant information from some selected text (smaller than a page long). This information will then be used to fill out a MS-Word template.
I have been opening the selected texts via a .txt file however I feel it will improve workflow if it were possible to copy & paste the selected text into some form of an input box.
I have tried the following:
Dim text As String
text = InputBox("Enter selected text here:")
This however only accepts a string (a single line of text).
Thanks, Donfernanado
As Rich Holton pointed out, you can create your own InputBox that supports the desired functionality:
First create a UserForm which looks like an InputBox. Mine is called CustomInputBox.
Set the MultiLine Property of the TextBox to True.
Example:
Then add some logic for the buttons and a Function to Show your Inputbox which takes some parameters like Prompt and Title:
Option Explicit
Private inputValue As String
Private Cancel As Boolean
Private Sub btnCancel_Click()
Cancel = True
Me.Hide
End Sub
Private Sub btnOK_Click()
If Me.txtInput.Value <> "" Then
inputValue = Me.txtInput.Value
End If
Me.Hide
End Sub
'This is the Function you are going to use to open your InputBox
Public Function Display(Prompt As String, Optional Title As String = "", Optional Default As String = "") As String
Cancel = False
Me.lblPrompt.Caption = Prompt
If Title <> "" Then
Me.Caption = Title
Else
Me.Caption = "Microsoft Excel"
End If
If Default <> "" Then
Me.txtInput.Value = Default
Else
Me.txtInput.Value = ""
End If
Me.txtInput.SetFocus
Me.Show vbModal
If Not Cancel Then
Display = inputValue
Else
Display = ""
End If
End Function
Now you are able to use your InputBox like this:
Dim text As String
text = CustomInputBox.Display("Enter selected text here:")

How to Select All Text in TextBox After textBox.Setfocus Using Access VBA

I need to select all the text in a textbox of an Access form when I click (or double click) into it. i tried the following code, unsuccessfully:
Me.txt_CompraPreco.SelStart = 0
Me.txt_CompraPreco.SelLength = Len(Me.txt_CompraPreco)
thanks in advance.
You can use the code shown below. If it doesn't work, place a breakpoint at the first line of code. If it doesn't stop on your breakpoint, then your event is not recognized.
Option Compare Database
Option Explicit
Private Sub txt_CompraPreco_Click()
If Len(Me.txt_CompraPreco & "") = 0 Then Exit Sub
Me.txt_CompraPreco.SelStart = 0
Me.txt_CompraPreco.SelLength = Len(Me.txt_CompraPreco)
End Sub
I was looking for a solution regarding this problem, I have the same issue, however, I have a solution to it, I'm not sure if it's efficient, but here's my code:
'Declare a flag
Public flagDblClick As Boolean
'Double click event
Private Sub txtbox_DblClick (Cancel As Integer)
flagDblClick = True
End Sub
'Mouse up Event
Private Sub txtbox_MouseUp(Button As Integer, Shift As Integer, X as Single, Y as Single)
If flagDblClick Then
flagDblClick = False
txtBox.SelStart = 0
txtBox.SelLength = Len(txtBox.Value)
End If
End Sub
This code will resolve your problem (use with userform).
txt_CompraPreco.SetFocus
Me.txt_CompraPreco.SelStart = 0
Me.txt_CompraPreco.SelLength = Len(Me.txt_CompraPreco)
My trial and error found this.
If your textfield is formatted as a Standard Number and you have set the decimal places to a certain length, you will run into trouble when you enter a single digit. For example if your decimal places in the field properties is set to 2 and you enter "1", you will display "1.00". To get the entire field (1.00) selected, you must specify the .Text property when you determine the .SelLength (not the default .Value property)
Me.txtYourFieldname_GotFocus
Me.txtYourFieldName.SelStart = 0
Me.txtYourFieldName.SelLength = Len(Me.txtYourFieldName.Text)
End Sub
This works for me:
Dim bSelect As Boolean
Private Sub fieldX_Click()
If bSelect Then
'Select text only at first mouse click then user can click again
'and is able to put mouse pointer where he prefers
Me.fieldX.SelStart = 0
Me.fieldX.SelLength = Len(Me.fieldX)
bSelect = False
End If
End Sub
Private Sub fieldX_GotFocus()
bSelect = True
'Select text if field got focus via keyboard, Enter or TAB
'this is not enough if field got focus via mouse click
Me.fieldX.SelStart = 0
Me.fieldX.SelLength = Len(Me.fieldX)
End Sub

Access Sign in Module

I'm trying to create a finance database that requires users to sign in and log out. I have that part working correctly. On the homepage of the database, I'm trying to get their last 25 (or X number) of transactions to display using a query. For some reason, I cannot get the code to pass as it shows a "Data type mismatch." Here is the various code - I'll explain each as I go:
Global Variables (My Global Module)
Option Compare Database
'global variables
Global C As Long
Global C2 As Long
Global HoldString As String
Global Flag As Boolean
Global Reply As String
Global mbReply As VbMsgBoxResult
Global User As String
Global GUser As Long
Global db As Database
The following are the Subs() to Log In (First Sub() is for Exit button, second sub() is for sign in button):
Option Compare Database
Private Sub B_Exit_Click()
mbReply = MsgBox(title:="Exit", _
prompt:="Are you sure you wish to exit the system?", _
Buttons:=vbYesNo)
If mbReply = vbNo Then
Exit Sub
Else
DoCmd.Quit acQuitSaveNone
End If
End Sub
Private Sub B_SignIn_Click()
'variables
Set db = CurrentDb()
Dim Employees As DAO.Recordset
Set Employees = db.OpenRecordset("Employees", dbOpenDynaset)
Dim isEmployeed As Boolean
Dim PassMatch As Boolean
Dim isTerm As Boolean
'check to see if the user is in the system
isEmployeed = False
PassMatch = False
isTerm = False
Do While Not Employees.EOF
If Employees![UserName] = T_Username.Value Then
isEmployeed = True
'make sure the employee is not terminated
If Employees![Terminated] = "Yes" Then
isTerm = True
End If
If isTerm = True Then
MsgBox ("This user has been terminated.")
Exit Sub
End If
'make sure password is correct
If Employees![Password] = T_Password.Value Then
PassMatch = True
End If
If PassMatch = False Then
MsgBox ("Incorrect Password.")
Exit Sub
End If
'mark signed in
Employees.Edit
Employees![SignedIn] = 1
Employees.Update
User = Employees![FirstName] & " " & Employees![LastName]
GUser = Employees![ID] 'Sets GUswer to equal record ID.
End If
Employees.MoveNext
Loop
If isEmployeed = False Then
MsgBox ("This username is not in the system.")
Exit Sub
End If
'close this form and open the main menu
Employees.Close
DoCmd.OpenForm FormName:="HomePage"
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
The next is my SQL code for the query:
SELECT TOP 25 Spend.ID, Spend.Vendor, Spend.MaterialGroup, Spend.GLCode, Spend.CostCenter, Spend.Department, Spend.InvoiceNumber, Spend.InvoiceDate, Spend.Amount, Spend.Tax, Spend.Total, Spend.DateEntered, Spend.DocNumber, Spend.Description, Spend.[Paid?], Spend.EnteredBy, Spend.EnteredBy
FROM Spend
WHERE (((Spend.[EnteredBy])="GUser"));
Spend.[EnteredBy] has a relationship with the Employees table. So EnteredBy is actually a number field because of this relationship.
If I hardcode the "WHERE" statement to be something like (((Spend.[EnteredBy])=2)); then the query will work fine.
Ultimately, what I want to happen is for the query to show the last 25 data entries that the logged on user completed.
Hope this makes sense. If there are questions, please let me know. I feel like I'm missing something small but I cannot figure it out.
Thanks,
Clark
Your query should read:
SELECT TOP 25 Spend.ID, Spend.Vendor, Spend.MaterialGroup, Spend.GLCode, Spend.CostCenter,
Spend.Department, Spend.InvoiceNumber, Spend.InvoiceDate, Spend.Amount, Spend.Tax, Spend.Total,
Spend.DateEntered, Spend.DocNumber, Spend.Description, Spend.[Paid?], Spend.EnteredBy, Spend.EnteredBy
FROM Spend WHERE (((Spend.[EnteredBy])=" & GUser & "));
Note the Ampersands ( & ) I placed before and after your GUser variable. This tells Access to evalute that expression and return the VALUE of it.
I'd also caution you against use the name "User" as a variable name. It's a Reserved Word in Access:
http://office.microsoft.com/en-us/access-help/access-2007-reserved-words-and-symbols-HA010030643.aspx

VBA Userform with Textbox - formatting the text

so I'm very new to VBA. I've created a very simple template that when opened, gives me a form to fill out which will insert text into a document through a commandbutton.
I'm trying to take it a step further a bit but am not sure how to go about bringing the code together. To insert the text, I'm using the bookmark feature. On my form, I have 4 Textboxes that act as options. If all 4 are filled in, the text looks like:
Option1Option2Option3Option4
I need it to look like:
Option1, Option2, Option3 and Option4
Not only that but I would like it so that the "and" is added depending on how many textboxes are filled in. For example, if I only have the first two filled it, I need it to look like:
Option1 and Option2
Does that make sense? Below is how it's structured currently. I would appreciate any pointers in moving forward.
Private Sub cmdSubmit_Click()
Application.ScreenUpdating = False
With ActiveDocument
.Bookmarks("Program1").Range.Text = TextBox1.Value
.Bookmarks("Program2").Range.Text = TextBox2.Value
.Bookmarks("Program3").Range.Text = TextBox3.Value
.Bookmarks("program4").Range.Text = TextBox4.Value
End With
Application.ScreenUpdating = True
Unload Me
End Sub
If these bookmarks are contiguous, there is no need for four bookmarks. Add the following module-level variables:
Private s As String, hasAnd As Boolean
Create a Sub which prepends the text of a textbox to the private variable, inserting a comma or and as appropriate:
Private Sub AppendText(txt As TextBox)
If Len(txt.Text) = 0 Then Exit Sub
If Len(s) = 0 Then
s = txt.Text
ElseIf Not hasAnd Then
hasAnd = True
s = txt.Text & " and " & s
Else
s = txt.Text & ", " & s
End If
End Sub
Call the subprocedure for each textbox in reverse order:
AppendText TextBox4
AppendText TextBox3
AppendText TextBox2
AppendText TextBox1
Then, use the value of s as the text of the bookmark:
ActiveDocument.Bookmarks("Program1").Range.Text = s