PDA

View Full Version : [SOLVED:] VBA to insert AutoText depending on a doc variable



AnnieM
01-06-2017, 07:08 AM
Hi,

I have a Word Template that includes a combobox (CmbCType). The result of the combobox is a doc variable called varCType.

Could anyone help me with code that would insert autotext ("Section7") into the document if varCType <>"Priority 1" or "Priority 2"? There are 8 sections within the document, so the autotext would be slotting between two other sections.

Any help will be greatly appreciated.

Anne

gmayor
01-06-2017, 10:14 PM
The following functions will write values to a named bookmark (here bmTest) already placed in the document, either a building block (autotext) from a named template, or a string value. I have assumed varCType is a string variable. You can call them from your code e.g.


Dim varCType As String
If Not varCType = "Priority 1" Or Not varCType = "Priority 2" Then
BBToBM "bmTest", ThisDocument.AttachedTemplate, "Section7"
Else
FillBM "bmTest, """
End If

You can call the functions as required using different values.


Public Sub BBToBM(strBMName As String, strTemplate As String, strBBName As String)
'Graham Mayor - http://www.gmayor.com
Dim oRng As Range
Dim iLen1 As Integer, iLen2 As Integer
With ActiveDocument
iLen1 = Len(ActiveDocument.Range)
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
Application.Templates(strTemplate). _
BuildingBlockEntries(strBBName).Insert _
Where:=oRng, _
RichText:=True
iLen2 = Len(ActiveDocument.Range)
oRng.End = oRng.End + (iLen2 - iLen1)
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

Public Sub FillBM(strBMName As String, strValue As String)
'Graham Mayor - http://www.gmayor.com
Dim oRng As Range
With ActiveDocument
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
oRng.Text = strValue
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

AnnieM
01-09-2017, 01:48 AM
Graham,

Thank you for your assistance.

I have put the 1st part of the code :

Dim varCType As String
If Not varCType = "Priority 1" Or Not varCType = "Priority 2" Then
BBToBM "bmTest", ThisDocument.AttachedTemplate, "Section7"
Else
FillBM "bmTest, """
End If

into the declarations section (of the module, not the userform, but have tried the userform as well) but I am getting the error 'Compile Error: Invalid Outside Procedure' with the first 'varCType' on line 2 being highlighted.

I am obviously doing something wrong, but can't figure this out. Can you please help further?

Regards,

Anne

gmayor
01-09-2017, 05:18 AM
The lines should be added to your macro. They won't work outside it. Then you need to indicate to the macro what the value of varCType actually is so that you can compare it with the priorities.
Without seeing the rest of your macro it is difficult to be specific. Can you post your document?

AnnieM
01-09-2017, 05:42 AM
Graham,

I have two areas of code, in the userform and a module:

Module Code


Option Explicit
Dim m_lngvarRef As Long
Public oVars As Word.Variables


Sub CallUF()
Dim oFrm As FrmDetails
Dim pStr As String
Dim oRng As Word.Range
Dim i As Long
Dim pMulSel As String
Set oVars = ActiveDocument.Variables
Set oFrm = New FrmDetails
With oFrm
.Show
oVars("varDate").Value = .txtDate.Text
oVars("varRef").Value = .txtRef.Text
oVars("varCompany").Value = .txtCompany.Text
oVars("varAdd1").Value = .txtAdd1.Text
oVars("varAdd2").Value = .txtAdd2.Text
oVars("varAdd3").Value = .txtAdd3.Text
oVars("varPostCode").Value = .txtPostCode.Text
oVars("varClient1st").Value = .txtClient1st.Text
oVars("varClientLast").Value = .txtClientLast.Text
oVars("varEmail").Value = .txtEmail.Text
oVars("varPrice").Value = .txtPrice.Text
oVars("varSite").Value = .txtSite.Text


If .CmbCType.Value <> "" Then
oVars("varCType").Value = .CmbCType.Value
Else: oVars("varCType").Value = "No response"
End If
If .CmbCDur.Value <> "" Then
oVars("varCDur").Value = .CmbCDur.Value
Else: oVars("varCDur").Value = "No response"
End If
If .CmbFreq.Value <> "" Then
oVars("varFreq").Value = .CmbFreq.Value
Else: oVars("varFreq").Value = "No response"
End If
If .CmbAsset.Value <> "" Then
oVars("varAsset").Value = .CmbAsset.Value
Else: oVars("varAsset").Value = "No response"
End If
If .CmbBilling.Value <> "" Then
oVars("varBilling").Value = .CmbBilling.Value
Else: oVars("varBilling").Value = "No response"
End If
UpdateThisFormsFields
End With


Unload oFrm
Set oFrm = Nothing
Set oVars = Nothing
Set oRng = Nothing
End Sub
Sub AutoNew()
'Create_Reset_Variables
CallUF
On Error Resume Next
m_lngvarRef = ThisDocument.Variables("varRef").Value
If Err.Number <> 0 Then
m_lngvarRef = 1
ThisDocument.Variables("varRef").Value = 1
ActiveDocument.Fields.Update
End If
On Error GoTo 0
lbl_Exit:
Exit Sub
End Sub

Sub AutoClose()
If Len(ActiveDocument.Path) > 0 Then
ThisDocument.Variables("varRef").Value = m_lngvarRef + 1
ThisDocument.Save
End If
lbl_Exit:
Exit Sub
End Sub

Sub AutoOpen()
CallUF
End Sub

Sub UpdateThisFormsFields()
Dim pRange As Word.Range
Dim iLink As Long
iLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each pRange In ActiveDocument.StoryRanges
Do
pRange.Fields.Update
Set pRange = pRange.NextStoryRange
Loop Until pRange Is Nothing
Next
End Sub


Sub Create_Reset_Variables()
With ActiveDocument.Variables
.Item("varDate").Value = " "
.Item("varRef").Value = " "
.Item("varCompany").Value = " "
.Item("varAdd1").Value = " "
.Item("varAdd2").Value = " "
.Item("varAdd3").Value = " "
.Item("varPostCode").Value = " "
.Item("varClient1st").Value = " "
.Item("varClientLast").Value = " "
.Item("varEmail").Value = " "
.Item("varPrice").Value = " "
.Item("varSite").Value = " "
.Item("varCType").Value = " "
.Item("varCDur").Value = " "
.Item("varFreq").Value = " "
.Item("varBilling").Value = " "
.Item("varAsset").Value = " "
End With


End Sub
************************************************************************
Userform



Option Explicit
Public boolProceed As Boolean


Private Sub cmdCancel_Click()
Me.Hide
End Sub


Private Sub cmdOK_Click()
Select Case ""
Case Me.txtDate.Value
MsgBox "Please fill-in the date."
Me.txtDate.SetFocus
Exit Sub
Case Me.txtRef.Value
MsgBox "Please fill-in the Quote Reference."
Me.txtRef.SetFocus
Exit Sub
Case Me.txtCompany.Value
MsgBox "Please fill-in the client company name."
Me.txtCompany.SetFocus
Exit Sub
Case Me.txtAdd1.Value
MsgBox "Please fill-in the address."
Me.txtAdd1.SetFocus
Exit Sub
Case Me.txtAdd2.Value
MsgBox "Please fill-in the address."
Me.txtAdd2.SetFocus
Exit Sub
Case Me.txtAdd3.Value
MsgBox "Please fill-in the address."
Me.txtAdd3.SetFocus
Exit Sub
Case Me.txtPostCode.Value
MsgBox "Please fill-in the postcode."
Me.txtPostCode.SetFocus
Exit Sub
Case Me.txtClient1st.Value
MsgBox "Please fill-in the client's 1st name."
Me.txtClient1st.SetFocus
Exit Sub
Case Me.txtClientLast.Value
MsgBox "Please fill-in the client's last name."
Me.txtClientLast.SetFocus
Exit Sub
Case Me.txtEmail.Value
MsgBox "Please fill-in the client's email address."
Me.txtEmail.SetFocus
Exit Sub
Case Me.txtSite.Value
MsgBox "Please fill-in site name and location."
Me.txtSite.SetFocus
Exit Sub
Case Me.txtPrice.Value
MsgBox "Please fill-in the quote price."
Me.txtPrice.SetFocus
Exit Sub
End Select



Me.boolProceed = True
Me.Hide
End Sub


Private Sub Frame2_Click()
txtDate = Format(Now, "MMMM d, yyyy")
End Sub


Private Sub Userform_Initialize()
Dim arrString() As String
With Me
With .CmbCType
.AddItem "Priority 1"
.AddItem "Priority 2"
.AddItem "Priority 3"
.AddItem "Priority 4"
.AddItem "Priority 5"
End With
With .CmbCDur
.AddItem "One Year"
.AddItem "Two Years"
.AddItem "Three Years"
.AddItem "Five Years"
.AddItem "One-Off"
End With
With .CmbFreq
.AddItem "x2 visits per annum"
.AddItem "x3 visits per annum"
.AddItem "x4 visits per annum"
.AddItem "x6 visits per annum"
.AddItem "x12 visits per annum"
.AddItem "One-Off"
End With
With .CmbAsset
.AddItem "A"
.AddItem "B"
.AddItem "C"
.AddItem "D"
.AddItem "E"
.AddItem "F"
.AddItem "G"
End With
With .CmbBilling
.AddItem "After Every Visit"
.AddItem "Monthly In Advance"
.AddItem "Monthly In Arrears"
.AddItem "Quarterly In Advance"
.AddItem "Quarterly In Arrears"
.AddItem "Annually In Advance"
.AddItem "Pro Forma"
End With

Me.txtDate = ActiveDocument.Variables("VarDate")
Me.txtRef = ActiveDocument.Variables("VarRef")
Me.txtCompany = ActiveDocument.Variables("VarCompany")
Me.txtAdd1 = ActiveDocument.Variables("VarAdd1")
Me.txtAdd2 = ActiveDocument.Variables("VarAdd2")
Me.txtAdd3 = ActiveDocument.Variables("VarAdd3")
Me.txtPostCode = ActiveDocument.Variables("VarPostCode")
Me.txtClient1st = ActiveDocument.Variables("VarClient1st")
Me.txtClientLast = ActiveDocument.Variables("VarClientLast")
Me.txtEmail = ActiveDocument.Variables("VarEmail")
Me.txtSite = ActiveDocument.Variables("VarSite")
Me.txtPrice = ActiveDocument.Variables("VarPrice")
Me.CmbCType = ActiveDocument.Variables("varCType")
Me.CmbCDur = ActiveDocument.Variables("varCDur")
Me.CmbFreq = ActiveDocument.Variables("varFreq")
Me.CmbAsset = ActiveDocument.Variables("varAsset")
Me.CmbBilling = ActiveDocument.Variables("varBilling")
lbl_Exit:
Exit Sub
End With
End Sub




Private Sub txtDate_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

txtDate = frmDatePicker.GetDate
lbl_Exit:
Exit Sub
End Sub



*************************************************************************** ***

Regards,

Anne

gmayor
01-09-2017, 11:00 PM
There are some anomalies in your code, but I have made some changes (see attached) to reflect your initial question. You can change the rest to match as you require.

AnnieM
01-10-2017, 09:22 AM
Graham,

That's fantastic! Thank you very much for your assistance with this.

I have been able to use the code you provided to achieve what I wanted with this project.

Anne