MS Word VBA Macro from validation - vba

I'm trying to do what, I think, ought to be the simplest of things, but I can't get it to work. i have an MS Word document with a number of legacy drop-down and text fields:
The first option in each drop-down is "Select ...", and if a user tabs out of one of the drop-downs without choosing something other than the first "Select ...", I want a msgbox to appear to tell them to make a selection, which works. What doesn't work, is that after the user dismisses the msgbox, I want the insertion point to return to the drop-down that they didn't select.
I understand that VBA has "timing issues", and from what I've read, one way to address these timing issues is to call the "return" macro from the validation macro. So I've written two macros:
Sub Validate()
' Dim strBookmark As String
' strBookmark = Selection.Bookmarks(1).Name
10: If (bool_debug) Then MsgBox ("NotSelected() - 10: strBookmark = " & strBookmark)
With ActiveDocument
If (strBookmark = "Locality") Then
Call Salary_Step
ElseIf (strBookmark = "Series") Then
20: If (bool_debug) Then MsgBox ("NotSelected() - 20: .FormFields(strBookmark).Name = " _
& .FormFields(strBookmark).Name)
If ((Len(.FormFields(strBookmark).Result) <> 4) Or (Not IsNumeric(.FormFields(strBookmark).Result))) Then _
MsgBox ("Please enter a 4 digit number.")
Call GoBackToPrevious(.FormFields(strBookmark).Name)
ElseIf (.FormFields(strBookmark).DropDown.Value = 1) Then
MsgBox ("Please select a " & Replace(Selection.FormFields(strBookmark).Name, "_", " ") & ".")
Call GoBackToPrevious(.FormFields(strBookmark).Name)
End If
End With
End Sub
and
Sub GoBackToPrevious(strPreviousField)
10: If (bool_debug) Then MsgBox ("GoBacktoPrevious - 10: strPreviousField = " & strPreviousField)
ActiveDocument.Bookmarks(strPreviousField).Range.Fields(1).Result.Select
End Sub
But when I tab out of any of the form fields, the insertion point jumps to the next form field and not back to the one that I just tabbed out of.
I know from the debug code that GoBackToPrevious is being passed the name of the current form field, but MS Word advances to the next field regardless.
I'd really appreciate it if someone can tell me how make MS Word return to and select the drop-down the user did not select appropriately instead of jumping to and selecting the next form field in the document.
Thank you.
P James Norris
EDIT:
Based on #TimothyRylatt comments, I have modified my macro and when they're called.
I have edited Validate as above (commenting out the Dim the strBookmark assignment, and I call it "on entry" to the next form field.
strBookmark is Dimed on the module's declaration section:
Option Explicit
Const bool_debug As Boolean = True
Const str_password As String = "###" ' I have a different password
Public strBookmark As String
and "on exit" from the "current" form field, I attempt to store the "current" bookmark name:
Sub StoreBookmark()
strBookmark = Selection.Bookmarks(1).Name
10: If (bool_debug) Then MsgBox ("StoreBookmark() - 10: strBookmark = " & strBookmark)
End Sub
which I call from the current form field "on exit".
But when I tab out of the current form field to the next form field, the insertion point doesn't go back to the "current" but instead stays in the next form field.
Anyone have any other suggestions/insights?
Thanks,
P James Norris

Related

Creating report for each value in listbox

I have a form, with a listbox. User can choose record and add it to a list box using listbox. I want to create a VBA script to open a report and match all the values in listbox with corresponding records. So far i can do this with single one, but for many i don't know what is going on. Here is the code:
Private Sub btnSearchMany_Click()
Dim i As Long
With Me.List12
If .ListCount = 0 Then
MsgBox "Brak wybranych wpisow.Dodaj wpisy, wybierajac je z listy i wciskajac przycisk dodaj.", vbCritical
Exit Sub
End If
For i = 0 To .ListCount - 1
DoCmd.OpenReport "rptKKsy", acViewReport, , "[tblKKsy].[KKS]='" & .List12(i) & "'"
Next i
End With
End Sub
List12- lisbox that user can add records "later i will rename it"
rptKKsy- my report
tblKKsy- table that stores values
KKs - one of the values stored in my table
I always getting error: method or data member not found. I tried to replace:
With Me.List12
with
With Forms("frmSearch").Form.list12
But it just created another error.
Edit: As suggested, my list box is a value list, and user can put thing in it by using a combobox and clicking a button ( button have addItem command programed). After user add some things, i want to open a report for each value stored in listbox. I dont want user to select things in listbox, because we will be using everything in it so its not nedded. I tried to use Item.Data property as June7 linked to, but ill be honest: I dont get it. Here is the code:
Private Sub btnSearchMany_Click()
Dim i As Long
Dim lValue As String
With Me.List12
For i = 0 To .ListCount - 1
If .ListCount = 0 Then
MsgBox "Brak wybranych wpisow.Dodaj wpisy, wybierajac je z listy i wciskajac przycisk dodaj.", vbCritical
Exit Sub
End If
Next i
End With
If i = Len(lValue) > 2 Then
DoCmd.OpenReport "rptKKsy", acViewReport, , "[tblKKsy].[KKS]='" & .ItemData(lValue) & "'"
End If
End Sub

Multiple text boxes to call the same VBA procedure

I am developing an Access Database and have several forms; all of which have the same text box on them.
The text box for each form is from the same record source, same name, same properties, etc. After the textbox is updated I have VBA running an Instr procedure which captures key phrases commonly used in these text boxes and replaces them with a common phrase.
How can I get each text box from each form to call the same procedure, that way if I have to improve the code over time I am only doing so in one place versus going to each form to update the code.
Example code.
textbox1_AfterUpdate()
Dim A as TextBox
Set A= Me.Textbox1
If InStr(A," Attachment Number ") Then
Me.FunctionalArea.SetFocus
A=Replace(A,"Attachment Number","<<Att."&" "& Left(Me.FunctionalArea).text,1)&""&"XXX>>")
A=SetFocus
End If
If InStr(A, " Program Name ") Then
A = Replace(A, " Program Name ", " <<ProgramNameXX>> ")
End If
If InStr(A, " Office Address ") Then
A = Replace(A, " Office Address ", " <<OfficeAddressXX>> ")
End If
You just call the code with a parameter of the textbox.
Something along the lines of
Public Sub textbox1_AfterUpdate()
DoTextBoxActions Me.Textbox1
End Sub
Public Sub DoTextBoxActions(ByRef ipTextBox As TextBox)
If InStr(ipTextBox.Text, " Attachment Number ") Then
ipTextBox.FunctionalArea.SetFocus
ipTextbox=Replace(ipTextbox.Text,"Attachment Number","<<Att."&" "& Left(ipTextbox.FunctionalArea).text,1)&""&"XXX>>")
ipTextBox.Parent.SetFocus = SetFocus
End If
If InStr(ipTextBox.Text, " Program Name ") Then
ipTextBox = Replace(ipTextBox.Text, " Program Name ", " <<ProgramNameXX>> ")
End If
If InStr(ipTextBox.Text, " Office Address ") Then
ipTextBox = Replace(ipTextBox, " Office Address ", " <<OfficeAddressXX>> ")
End If
End Sub
You can do this.
When you place that text box on each form, in place of building a "event" code stub, you can enter this:
=MyFunctionName()
Or, thus in your case, you would place this code in a standard code module (NOT the forms code module).
Public Function MyGlobalAfterUpdate
' pick up the form and the control
' do this first, do this fast, do this right away
' since a timer event, mouse click, focus change etc. can
' case the screen.ActiveForm, and screen.ActiveControl to change
' once we grab these values, then you ok
Debug.Print "global after"
Dim MyControl As TextBox
Dim MyForm As Form
Set MyForm = Screen.ActiveForm
Set MyControl = Screen.ActiveControl
Debug.Print "Control name = " & MyControl.Name
Debug.Print "Text of control = " & MyControl.Value
Dim strText As String
strText = MyControl.Value
Debug.Print strText
' note that we have FULL use of the form values
' in place of me!Some value, or control?
' you can go
MyForm.Refresh
MyForm!LastUpdate = now()
' save the data in the form
' If MyForm.Dirty = true then MyForm.Dirty = False
End sub
So you are free to do whatever you want in this code. And you simple replace "me" the forms reference with MyForm, but once you grabbed the active form, then anything you would or could do with "Me", you can do the SAME with MyForm. As noted, you could in theory using Screen.ActiveForm, but you are MUCH better to pick up a reference as fast as possible and as soon as possible, since those values and focus could change, and often it will - so get/grab/take a reference to the controls as fast and as soon as possible. Once you grabbed the reference from screen, then minor changes in focus etc. don't matter - since you picked up the form and control right away.
The key concept, the key takeaway? you can grab both the current form with screen.ActiveForm, and you can get/grab the current control that fired the after update event with Screen.ActiveControl.
So, in summary:
Don't create a code stub in the form. In the controls after update event, place the name of the PUBLIC function in a STANDARD code module.
eg like this:
=MyGlobalAfterUpdate()

How to refill combobox with similar records based on what user types

I'm currently building a form where a user can look up a tool based on the description or part number.
I want user to be able to type any letters into the combobox that I have tied to a query listing all my tools and the combobox will repopulate itself with the tools most similar to what is present in their combobox. For example, if they start typing wre, then tools that have similar characters will start appearing in the combobox such as wrench, torque wrench, power wrench, etc.
I've tried looking around for other people's solutions to this but either I didn't fully comprehend the existing solution (I'm fairly new to Access) or it wasn't what I was looking for. I've seen that people suggested using a listbox instead but I really don't want to go down that route.
I was thinking about using what the user types in the combobox and my VBA code will pick up the "change event" and requery the combobox on the fly by using their input as the like criteria for the new query.
Is this a possible route? Will it be slower? Is there a better route?
I'm hoping someone can show some examples on how to achieve what I'm looking for.
The search as you type feature is very useful! With a textbox and a listbox, you can setup a dynamic search tool that will filter a list for approximate matches as you type. The textbox has four events associated with it, as seen here.
The code behind the form looks like this. Pay attention to the part in bold. This is where we create a string of SQL commands, and utilize the SQL Like operator, to get dynamic matches as we type. Pay attention to the text in bold below.
Option Compare Database
Option Explicit On
Private blnSpace As Boolean 'INCLUDE THIS LINE ON YOUR FORM
Private Sub btnClearFilter_Click()
'CODE FOR THE RED "X" BUTTON TO CLEAR THE FILTER AND SHOW ALL
On Error Resume Next
Me.txtSearch.Value = ""
txtSearch_Change()
End Sub
Private Sub txtSearch_Change()
'CODE THAT HANDLES WHAT HAPPENS WHEN THE USER TYPES IN THE SEARCH BOX
Dim strFullList As String
Dim strFilteredList As String
If blnSpace = False Then
Me.Refresh 'refresh to make sure the text box changes are actually available to use
'specify the default/full rowsource for the control
strFullList = "SELECT RecordID, First, Last FROM tblNames ORDER BY First;"
'specify the way you want the rowsource to be filtered based on the user's entry
strFilteredList = "SELECT RecordID, First, Last FROM tblNames WHERE [First] LIKE ""*" & Me.txtSearch.Value &
"*"" OR [Last] LIKE ""*" & Me.txtSearch.Value & "*"" ORDER BY [First]"
'run the search
fLiveSearch Me.txtSearch, Me.lstItems, strFullList, strFilteredList, Me.txtCount
End If
End Sub
Private Sub txtSearch_KeyPress(KeyAscii As Integer)
'NECESSARY TO IDENTIFY IF THE USER IS HITTING THE SPACEBAR
'IN WHICH CASE WE WANT TO IGNORE THE INPUT
On Error GoTo err_handle
If KeyAscii = 32 Then
blnSpace = True
Else
blnSpace = False
End If
Exit Sub
err_handle:
Select Case Err.Number
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & "(" & Erl() & ")"
End Select
End Sub
Private Sub txtSearch_GotFocus()
' USED TO REMOVE THE PROMPT IF THE CONTROL GETS FOCUS
On Error Resume Next
If Me.txtSearch.Value = "(type to search)" Then
Me.txtSearch.Value = ""
End If
End Sub
Private Sub txtSearch_LostFocus()
' USED TO ADD THE PROMPT BACK IN IF THE CONTROL LOSES FOCUS
On Error Resume Next
If Me.txtSearch.Value = "" Then
Me.txtSearch.Value = "(type to search)"
End If
End Sub
Finally, in a regular module, you will need this script.
Option Compare Database
Option Explicit On
'************* Code Start **************
' This code was originally written by OpenGate Software
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' OpenGate Software http://www.opengatesw.net
Function fLiveSearch(ctlSearchBox As TextBox, ctlFilter As Control,
strFullSQL As String, strFilteredSQL As String, Optional ctlCountLabel As Control)
Const iSensitivity = 1 'Set to the number of characters the user must enter before the search starts
Const blnEmptyOnNoMatch = True 'Set to true if you want nothing to appear if nothing matches their search
On Error GoTo err_handle
'restore the cursor to where they left off
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
If ctlSearchBox.Value <> "" Then
'Only fire if they've input more than two characters (otherwise it's wasteful)
If Len(ctlSearchBox.Value) > iSensitivity Then
ctlFilter.RowSource = strFilteredSQL
If ctlFilter.ListCount > 0 Then
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
Else
If blnEmptyOnNoMatch = True Then
ctlFilter.RowSource = ""
Else
ctlFilter.RowSource = strFullSQL
End If
End If
Else
ctlFilter.RowSource = strFullSQL
End If
Else
ctlFilter.RowSource = strFullSQL
End If
'if there is a count label, then update it
If IsMissing(ctlCountLabel) = False Then
ctlCountLabel.Caption = "Displaying " & Format(ctlFilter.ListCount - 1, "#,##0") & " records"
End If
Exit Function
err_handle:
Select Case Err.Number
Case 91 'no ctlCountLabel
'exit
Case 94 'null string
'exit
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & vbCrLf & "Line: " & Erl()
End Select
End Function
The code comes from this link:
http://www.opengatesw.net/ms-access-tutorials/Access-Articles/Search-As-You-Type-Access.html

Subform blocking Recordset.AddNew (Error 3027)

Having a subform displaying the same table used in recordset makes the table read only (error 3027). Getting rid of the subform fixes the problem. Similar setup works in my other form interface.
I tried to delete the subform, which fix the accessibility problem. But that would defeat the original UX purpose.
Option Explicit
Public UnitRS As DAO.Recordset
Public ModelRS As DAO.Recordset
Public NameUnitRecords As String
Public NameModelRecords As String
Public Sub Form_Load()
'Initialization
NameUnitRecords = "tblBatteriesMainRecordsUnits"
NameModelRecords = "tblBatteriesRecordsModels"
End Sub
Private Sub SetUnitRecordsets()
'Set the path to the Battery Records table
Set UnitRS = CurrentDb.OpenRecordset(NameUnitRecords, dbOpenDynaset)
End Sub
Private Sub txtBatteryID_AfterUpdate()
'Set the recordset path for unit records
Call SetUnitRecordsets
'do a findfirst search for the Battery ID, using value from textbox txtBatteryID
UnitRS.FindFirst "[Battery ID]=" & txtBatteryID
'If no matching record, leave the other fields empty
If UnitRS.NoMatch Then
'If there is a matching record, then, grab the model number
Else
'as there is an existing record with model number, run a search on the model number and grab the model info
End If
'close recordset
UnitRS.Close
'check if the button can be enabled
End Sub
Private Sub cmbModelNumber_AfterUpdate()
'Set the recordset path for model records
'do a findfirst search for the Model Number, using value from combobox cmbModelNumber
'If no matching record, leave the other fields empty
If ModelRS.NoMatch Then
'If there is a matching record, then, grab the Model Info
Else
End If
'close recordset
'check if the button can be enabled
End Sub
Private Sub btnSaveAndCLear_Click()
Dim Response, strOldModelNumber
'Set the recordset path for unit records
Call SetUnitRecordsets
'Set the recordset path for model records
'close all related tables, queries and forms
DoCmd.Close acTable, NameUnitRecords, acSaveYes
DoCmd.Close acForm, "frmSubBatteriesMainRecordsUnits", acSaveYes
'If a new model record is required
ModelRS.FindFirst "[Model Number]='" & cmbModelNumber & "'"
If ModelRS.NoMatch Then
'msg box confirm model information
'If user chooses yes
If Response = vbYes Then
'create new model record
'this block could be done with "With...End" format for less error vulerability?
'nah, unless it is repetitively called, it's too much work to inplement just the .addnew part
'requery the two combobox to reflect newest changes
'User chooses no
Else
'popup a message telling the user the battery and model record is not logged, but don't clear the field.
Exit Sub
End If
End If
'need to find the record first, otherwise it will edit the first one
UnitRS.FindFirst "[Battery ID]=" & txtBatteryID
'store the old model number value
strOldModelNumber = UnitRS("Model Number")
'New record
If UnitRS.NoMatch Then
'create a new battery record
UnitRS.AddNew
UnitRS("Battery ID") = Me.txtBatteryID
'If this is an edit on existing record
Else
'if the new value is the same as the old one
If strOldModelNumber = cmbModelNumber Then
'msgbox the same value, no change is done to the database
MsgBox "the data is the same as the old record, no change is made to the record", vbInformation, "Same data"
Exit Sub
Else
'msg box confirm edit
Response = MsgBox("Please confirm edit on existing record: " & Chr(13) & Chr(10) & "BatteryID: " & txtBatteryID & Chr(13) & Chr(10) & "Model Number: " & cmbModelNumber, vbYesNo, "New Model Record Dectected")
'If user chooses yes
If Response = vbYes Then
'goto edit mode
UnitRS.Edit
'if user chooses no
Else
'msgbox notify the user nothing is changed in the database
MsgBox "Battery and Model record not logged, you may retry logging", vbInformation, "Record not logged"
Exit Sub
End If
End If
End If
'both changes the model number and comment field anyway
UnitRS("Model Number") = Me.cmbModelNumber
UnitRS("Comment") = Me.txtComment
'commit update
UnitRS.Update
UnitRS.Close
'clear all flieds
'reset all locks
'requery the sub form to reflect the newest changes
Me.subFrmBatteryRecords.Requery
End Sub
What I would like to achieve is to have a display in the form interface to show the content of the actual record table, so that the user knows what is in the table.
There is nothing wrong with my code. There is a property option in the form object, it's called "record lock", somehow mine had "All Records" selected. By making it "No locks", the accessibility problem is gone.

Select combobox if wrong item selected

I have an MS-Word 2013 document with several (legacy) formfields; some text boxes, some comboboxes. The first list item on all of the comboboxes is "(select one)" to let the end user know they need to make a selection (I did not draft or design this document, I've just been asked to write the VBA code for it). So I coded each to give a simple VBA message box, ran on exit, if that first selection was not changed, for example:
Public factor1 As Integer
Sub MyFormFieldFactor1()
If ActiveDocument.FormFields("cbofactor1").Result = "(select one)" Then
MsgBox "You must select either Yes or No."
Exit Sub
End If
If ActiveDocument.FormFields("cbofactor1").Result = "Yes" Then
factor1 = 1
Else
factor1 = 0
End If
End Sub
The word document automatically goes to the next formfield when you click ok on the message box. Through VBA, I want it to stay on the current formfield when "(select one)" is chosen. Bonus points if it stays on the current field and pulls up the list selection automatically.
Will this work:
If ActiveDocument.FormFields("cbofactor1").Result = "(select one)" Then
MsgBox "You must select either Yes or No."
ActiveDocument.FormFields("cbofactor1").SetFocus()
Exit Sub
End If
You can auto drop the list with something like:
SendKeys "%{down}", True
DoEvents
Full code:
If ActiveDocument.FormFields("cbofactor1").Result = "(select one)" Then
MsgBox "You must select either Yes or No."
ActiveDocument.FormFields("cbofactor1").SetFocus()
SendKeys "%{down}", True
DoEvents
Exit Sub
End If