Hey guys, I'm working on cases that are dropdown menu dependent and I'm stuck on the code. I have extracted some from an other macro, but am now over my head. The two cases below are controlled by the dropdown menu. Here's the code.
Code:
Sub ConditionalContentPublicRecords()
'
' ConditionalContent Macro
Application.ScreenUpdating = False
Dim Prot As Variant, BkMrkRng As Range, Rng As Range, FmFld As FormField
Dim StrFmt As String, CCBmk As Boolean
With ActiveDocument
Prot = .ProtectionType
Application.ScreenUpdating = False
Select Case Selection.FormFields("RecordsDD").Result
Case "U.S. Public Records Index": CCBmk = True: StrFmt = " vol."
Case "United States Public Records 1970-2010": CCBmk = True: StrFmt = " database,"
Case Else: CCBmk = False: StrFmt = ""
End Select
If .ProtectionType <> wdNoProtection Then
Prot = .ProtectionType
.Unprotect
'Update the bookmark referenced via BmkPopn
Set BkMrkRng = .Bookmarks(CCBmk).Range
If (CCBmk = True) And (Len(BkMrkRng.Text) = 0) Or _
(CCBmk = False) And (Len(BkMrkRng.Text) <> 0) Then
If (CCBmk = True) And (Len(BkMrkRng.Text) = 0) Then
BkMrkRng.Text = ", "
Else
BkMrkRng.Delete
End If
.Bookmarks.Add CCBmk, BkMrkRng
End If
Select Case .FormFields("RecordsDD").Result
Case "U.S. Public Records Index"
If InStr(BkMrkRng.Text, ", vol. ") = 0 Then
'Text & Formfield for volume
With Rng
.Text = StrFmt & ", vol. "
.Collapse wdCollapseEnd
End With
Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormTextInput)
FmFld.TextInput.EditType wdRegularText, "X"
With Rng
.Collapse wdCollapseEnd
.InsertAfter ", "
.End = FmFld.Range.End
.Collapse wdCollapseEnd
' Ancestry Text and Viewing Record Date
.InsertAfter " Ancestry (http://www.ancestry.com : viewed " & _
Format(Now, "d MMMM yyyy") & "),"
.Words(4).Font.Italic = True
.Collapse wdCollapseEnd
.InsertAfter ", entry for"
'Name Form Field
End With
Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormTextInput)
FmFld.TextInput.EditType wdRegularText, "Name"
With Rng
.Collapse wdCollapseEnd
.InsertAfter ", "
.End = FmFld.Range.End
.Collapse wdCollapseEnd
Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormTextInput)
FmFld.TextInput.EditType wdRegularText, "Place"
'Place Form Field
With FmFld
.Name = "Place"
.EntryMacro = ""
.ExitMacro = "UnlinkFields"
.Enabled = True
.TextInput.EditType Type:=wdRegularText, Default:="X", Format:="Title case"
.TextInput.Width = 0
End With
'Additional Text
With Rng
.Collapse wdCollapseEnd
.InsertAfter ", citing "" voter registration lists, public record filings, historical residential records, and other household database listings."""
.End = FmFld.Range.End
.Collapse wdCollapseEnd
Select Case .FormFields("RecordsDD").Result
Case "United States Public Records 1970-2010"
If (InStr(BkMrkRng.Text, "database") = 0) Then
With Rng
.Text = StrFmt & ", database, "
.Collapse wdCollapseEnd
.InsertAfter "FamilySearch.org (https://www.familysearch.org/search/collection/2199956 : viewed " & _
Format(Now, "d MMMM yyyy") & "), citing ""telephone directories, property tax assessments, credit applications, and other records available to the public,"" entry for """
.Words(4).Font.Italic = True
.Collapse wdCollapseEnd
End With
'Firstname Lastname Form Field
Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormTextInput)
With FmFld
.Name = "FirstnameLastname"
.EntryMacro = ""
.ExitMacro = "UnlinkFields"
.Enabled = True
.TextInput.EditType Type:=wdRegularText, Default:="X", Format:="Title case"
.TextInput.Width = 0
End With
With Rng
.End = FmFld.Range.End
.InsertAfter "."
.Collapse wdCollapseEnd
End With
'Case Else: BkMrkRng.Text = ""
End Select
If Not FmFld Is Nothing Then BkMrkRng.End = FmFld.Range.End
End If
.Protect Type:=Prot, Password:=Pwd, NoReset:=True
End If
End With
Set FmFld = Nothing: Set Rng = Nothing: Set BkMrkRng = Nothing
Application.ScreenUpdating = True
End Sub