Background: a proprietary piece of veterinary software generates a document pre-populated with merge fields containing data for a particular patient.
The field I am interested in is weight but its a string (Top_Stat) that looks like this "24.5 kg".
I have created a script to read that field and convert it into an integer. However I now want to use this integer to male medication dose calculations based on the animal weight.
As create document variables for this but the variable (name and value) gets stored in the document. I want at least the value to be removed but can't seem to get the result with the following script.
Sub GetWeight()
ActiveDocument.Variables("WeightInKg").Delete
WeightInt = ActiveDocument.MailMerge.DataSource.DataFields("Top_Stat").Value
WeightInt = Replace(WeightInt, " kg", "") 'This removes the superfluous text
WeightInt = Val(WeightInt) 'This converts the weight into a number (integer)
ActiveDocument.Variables.Add Name:="WeightInKg", Value:=WeightInt 'Add the Word variable
ActiveDocument.Fields.Update
End Sub
What am I missing? Apologies, I am new to VBA.
Your code needs some error checking. This first time it is run the document variable "WeightInKg" does not exist and when you go to delete it, the routine errors out.
Document variables, not to be confused with VBA Subroutine variables are not Word document fields so unless you have another reason for updating all fields, that code line is unnecessary.
Finally, you should always declare your VBA Subroutine variables.
I have modified your code but could not fully test it because I don't have your mail merge data source ... but give it a try and see if it now works for you.
Sub AutoOpen()
Call GetWeight
End Sub
Sub GetWeight()
Dim WeightIn As Long
On Error Resume Next
ActiveDocument.Variables("WeightInKg").Delete
On Error GoTo ErrHandler
WeightInt = ActiveDocument.MailMerge.DataSource.DataFields("Top_Stat").Value
WeightInt = Replace(WeightInt, " kg", "") 'This removes the superfluous text
WeightInt = Val(WeightInt) 'This converts the weight into a number (integer)
ActiveDocument.Variables.Add Name:="WeightInKg", Value:=WeightInt 'Add the Word variable
' ActiveDocument.Fields.Update
ErrHandler:
If Err.Number > 0 Then
MsgBox Err.Number & vbCr & Err.Description, vbCritical
Err.Clear
End If
End Sub
This is the screenshot of the Word document I am trying to populate.
Screenshot
Related
I am creating a Word template that performs a bunch of actions when Document_New is initialised. For example, I am pulling in and applying Custom Document Properties from an XML file in one sub, and referring to them in a second.
I'm trying to add some error handling to close the document with an error message and prevent the rest of the VBA from running, and I can get to the point where the document closes, but the rest of the VBA code continues to execute. Ideally I need to close just this new document (other Word documents may be open on a device) and stop any more processing of VBA.
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
When this is in place, the template seems to close, but the newly created document still exists and the template VBA continues to run.
Is anyone able to suggest a way to close the template and abort the creation of the new document?
EDIT: Including an example of how I'm looking for errors.
In Document_New - I call ValidateProperties that loops through an arrayProps array that stores properties required for the template. Each property in the array is checked using the function CustomDocumentPropertyExists and if that returns false I call the sub ExitFailedValidation. This is the sub I want to call if the template fails a validation test. I want to be able to cleanly close the new document without saving and leave any other Word windows open.
Sub ValidateProperties()
Dim arrayProps(1) As String
Dim i As Long
arrayProps(0) = "prop-doc-blueprint"
arrayProps(1) = "prop-doc-stationery"
For i = 0 To UBound(arrayProps)
If CustomDocumentPropertyExists(arrayProps(i)) = False Then
ExitFailedValidation ("The required custom document property " & arrayProps(i) & " is missing. Please check " & _
"the config.xml file to ensure it is included.")
End If
Next i
End Sub
Sub ExitFailedValidation(Message As String)
MsgBox "The Template failed to load and validate." & vbCrLf & vbCrLf & _
Message, vbCritical, "Error loading template"
MsgBox ThisDocument.Name
MsgBox ActiveDocument.Name
ThisDocument.Close SaveChanges:=wdDoNotSaveChanges
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
The Document_New() is the entrance point in code, so it should handle the tasks that need to be run and take appropriate action should an error occurs or something did not go as expected as in your case.
In order to be able to do that, the tasks it calls must report their status, e.g. completed, failed, something is missing etc.
Therefore, change the ValidateProperties() sub into a function that returns true or false and pass a string to it as an output parameter that will hold the error message if the function fails. If all goes well, it will simply be unused.
The main point of the app. This method decides what happens in the app.
Private Sub Document_New()
Dim errorMessage As String
If Not TryValidateProperties(errorMessage) Then
ExitFailedValidation errorMessage
Exit Sub
End If
'all good - continue
End Sub
The ValidateProperties() sub changed to a method that returns true or false with an optional error message if something is wrong. Since false is the default value of a boolean, exiting the function if a property doesn't exist will return false - no need to set it explicitly.
Private Function TryValidateProperties(ByRef outMessage As String) As Boolean
'...
For i = 0 To UBound(arrayProps)
If Not CustomDocumentPropertyExists(arrayProps(i)) Then
outMessage = "The required custom document property " & arrayProps(i) & " is missing. Please check " & _
"the config.xml file to ensure it is included."
Exit Function
End If
Next i
'all good
TryValidateProperties = True
End Function
Lastly, the helper method for communicating the error. In my opinion, the document shouldn't be closed here, but within the Document_New() method if property validation fails, but I'll leave this with you.
Private Sub ExitFailedValidation(Message As String)
MsgBox Message
End Sub
To add error handling in a method:
Sub T()
On Error GoTo Trap
'main method body
Leave:
'Release any references here, e.g. close db connection, release file handle etc.
Exit Sub
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
I'm having some trouble figuring this out, and would really appreciate some help. I'm trying to write a macro that uses the selection.text property as a Case text-expression. When the macro is clicked in Microsoft Word, the selected text is automatically set to the DisplayText. This method worked great for the formatting via Selection.Font.Color for a quick and dirty formatting toggling macro, but it doesn't work for the actual text.
When debugging with MsgBox, it is showing a box (Eg: □ ) as the value.
For example,
Word Field Code:
{ MACROBUTTON Macro_name DisplayText }
VBA Code run when highlighting "DisplayText" in Word:
Sub Macro_name()
Dim Str As String
Str = Selection.Text
MsgBox Str
Select Case Str
Case "DisplayText"
MsgBox "A was selected"
Case "B"
MsgBox "B was selected"
End Select
End Sub
What is output is a Message Box that only shows □
When I run this macro with some regular text selected, it works just fine.
My question is this: Is there a way to have the macro read the displaytext part of the field code for use in the macro?
You can read the field code, directly, instead of the selection (or the Field.Result which also doesn't give the text).
It's not quite clear how this macro is to be used throughout the document, so the code sample below provides two variations.
Both check whether the selection contains fields and if so, whether the (first) field is a MacroButton field. The field code is then tested.
In the variation that's commented out (the simpler one) the code then simply checks whether the MacroButton display text is present in the field code. If it is, that text is assigned to the string variable being tested by the Select statement.
If this is insufficient because the display text is "unknown" (more than one MacroButton field, perhaps) then it's necessary to locate the part of the field code that contains the display text. In this case, the function InstrRev locates the end point of the combined field name and macro name, plus the intervening spaces, in the entire field code, searching from the end of the string. After that, the Mid function extracts the display text and assigns it to the string variable tested by the Select statement.
In both variations, if the selection does not contain a MacroButton field then the selected test is assigned to the string variable for the Select statement.
(Note that for my tests I needed to use Case Else in the Select statement. You probably want to change that back to Case "B"...)
Sub Display_Field_DisplayText()
Dim Str As String, strDisplayText As String
Dim textLoc As Long
Dim strFieldText As String, strMacroName As String
Dim strFieldName As String, strFieldCode As String
strDisplayText = "text to display"
If Selection.Fields.Count > 0 Then
If Selection.Fields(1).Type = wdFieldMacroButton Then
strFieldName = "MacroButton "
strMacroName = "Display_Field_DisplayText "
strFieldCode = strFieldName & strMacroName
Str = Selection.Fields(1).code.text
textLoc = InStrRev(Str, strFieldCode)
strFieldText = Mid(Str, textLoc + Len(strFieldCode))
MsgBox strFieldText
Str = strFieldText
'If InStr(Selection.Fields(1).code.text, strDisplayText) > 0 Then
' Str = strDisplayText
'End If
End If
Else
Str = Selection.text
End If
Select Case Str
Case strDisplayText
MsgBox "A was selected"
Case Else
MsgBox "B was selected"
End Select
End Sub
I think I need to try and make this question easier. So here goes;
I am creating a User form in Excel that will act as a data capture form.
In this form I have a Textbox called PolBX In this a is placed and at submission data in PolBX is copied into the "G" column using this code
Cells(emptyRow, 7).Value = PolBX.Value. This works great.
I discovered that there may be instances where the User may accidently use the same Unique Id number twice. so I am trying to find out how to code it that after the User has entered the Unique Id number it would check for that string (Consists of letters and numbers). if it finds the string already in the 7th column(G) it must say something like
"Policy number already Used, please try again"
I am thinking I will need to use the following subroutine
Private Sub PolBX_AfterUpdate()
End Sub
Can some please assist with creating this code...
Also can you please explain what you are doing as I started VBA about a week ago
You can add the following code to search for your policy number, and if nothing found then PolLookup = Nothing.
Option Explicit
Sub Test()
On Error GoTo ErrHandler
Dim ws As Worksheet, PolLookup As Range, LookupRng As Range
Set ws = ThisWorkbook.Worksheets(1)
'This is the range you want to search, it can be a long range
'or it can be a single cell.
Set LookupRng = ws.Range("A:A")
'Range.Find is looking for your value in the range you specified above
Set PolLookup = LookupRng.Find("YourLookupValue")
'PolLookup = Nothing if it didn't find a match, so we want to use
'If <NOT> Nothing, because this suggests .Find found your value
If Not PolLookup Is Nothing Then
Err.Raise vbObjectError + 0 'Whatever error you want to throw for finding a match
End If
'Exit before you reach the ErrHandler
Exit Sub
ErrHandler:
If Err.Number = vbObjectError + 0 Then
'Handle your error. Do you want to stop completely? Or have the
'User enter a new value?
End If
End Sub
Basically, after your user enters their value in your UserForm, just make a call to this Sub to do a quick lookup.
Playing around I discovered a Much easier way! I included a Button with he following code attached
Private Sub CommandButton8_Click()
Search = PolBX.Text
Set FoundCell = Worksheets("sheet1").Columns(7).Find(Search,LookIn:=xlValues, lookat:=xlWhole)
If FoundCell Is Nothing Then
MsgBox "No duplicates found"
Else
MsgBox "This policy has already been Assessed" & "Please assess a different case"
PolBX.Value = ""
End If
I am trying to build template invoices for Xero. Xero looks for specific fields in your MS Word template and inputs the variable assigned to that text field name in your given format. In word you can toggle the field code to view as just the field name:
«InvoiceNumber»
or the name with format:
{ MERGEFIELD InvoiceNumber \* MERGEFORMAT}
This outputs: INV1234 successfully into the template. Now what I need to do is output just the last 4 characters.
This post seems to imply it must be done with a VBA. I put together a macro with Visual Basic in word and this is where I have hit trouble:
Sub InvoiceNumber()
Dim MyInv As FormFields
Set MyInv = ActiveDocument.FormFields
If MyInv("Text1").Result = "InvoiceNumber" Then
MyInv("Text1").CheckBox.Value = Right(MyInv("Text1"), 4)
End If
End Sub
This returns with
error 5941: The requested member of the selection does not exist
I am quite a beginner with VB macros in word, what am I doing wrong and how should I instead be trying to call the InvoiceNumber Field?
Please try with the following solution:
Sub InvoiceNumber()
Dim MyInv As Field
Set MyInv = GetFieldByName("InvoiceNumber")
If Not MyInv Is Nothing Then
'do something with field result...
'here... debug to Immediate window
Debug.Print Right(MyInv.Result, 4)
End If
End Sub
Function GetFieldByName(fName As String) As Field
Dim F As Field
For Each F In ActiveDocument.Fields
'if not working try with (1) istead of (2) in line below
If Split(Replace(F.Code, " ", " "), " ")(2) = fName Then
Set GetFieldByName = F
Exit Function
End If
Next F
Set GetFieldByName = Nothing
End Function
I'm current trying to write a macro (VBA in Word) that will compile information from a collection of documents into a single document.
I order to do this I have a list of ~20 checkboxes that will determine which documents I want to include in the compilation. My issue is that when writing the macro, I can't figure out a way of checking the state of each checkbox on my list without re-writing the same block of code 20 times, only changing the name of the checkbox. eg CB1 to CB2, CB3 CB4 etc. each time.
This is the block of code in question. It does work if I rewrite it multiple times for the changing check box number but I would prefer it in a loop so the code is more compact and robust:
If ThisDocument.CB1.Value = True Then
Documents.Open(directory).Activate
Selection.WholeStory
Selection.Copy
Documents(NewFile).Activate
Selection.Paste
Documents("file.docx").Close
End If
Ideally I would like to have the check box named something like CBn, where n is a variable that I can redefine at the end of each loop.
There's no option for directly referring to a control by its name - you can wrap that up in a function though:
Sub Tester()
Dim x As Long, cb As Object
For x = 1 To 3
'find the checkbox
Set cb = ControlByName("CB" & x, ThisDocument)
'check we got something back
If Not cb Is Nothing Then
Debug.Print "CB" & x & " is " & cb.Value
End If
Next x
End Sub
Function ControlByName(sName, doc As Document) As Object
Dim obj
For Each obj In doc.InlineShapes
If obj.OLEFormat.Object.Name = sName Then
Set ControlByName = obj.OLEFormat.Object
Exit Function
End If
Next obj
End Function