Help with drop down menu changing Italic font when unlinked

[brent chadwick]

Hey guys, I have a macro with a drop down and the exit macro is changing the Italic font when the fields are unlinked. I have a exit macro that protects the font but does not work on this particular macro. I'm stumped-
Here's the code for the macros-

Sub ObituaryCombinedMacro()
' Obituary Combined Macro
Application.ScreenUpdating = False
Dim Rng As Range, FmFld As FormField
Set Rng = Selection.Range
With ActiveDocument
.Bookmarks.Add Name:="Start"
  Rng.Collapse wdCollapseStart
  'Dropdown Menu for Record Collection
  Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormDropDown)
  With FmFld
    .Name = "ObituaryDD"
    .EntryMacro = ""
    .ExitMacro = "CondtionalContentObituaries"
    .Enabled = True
    With .DropDown.ListEntries
      .Add Name:="Obit Websites"
      .Add Name:="Ancestry"
      .Add Name:="Legacy"
      .Add Name:="ObitsforLife"
      .Add Name:="Obituaries.com"
      .Add Name:="Rootsweb"
      .Add Name:="Tributes"
      End With
      With Rng
     .End = FmFld.Range.End
     .Font.Italic = True
     .Collapse wdCollapseEnd
    End With
    End With
  .Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=Pwd
  End With
  Set FmFld = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
Sub CondtionalContentObituaries()
Application.ScreenUpdating = False
Dim Prot As Variant, Rng As Range, FmFld As FormField
Const Pwd As String = ""
With ActiveDocument
  Prot = .ProtectionType
  If .ProtectionType <> wdNoProtection Then
    Prot = .ProtectionType
    .Unprotect Password:=Pwd
    With .FormFields("ObituaryDD")
      Set Rng = .Range.Paragraphs.First.Range
      Rng.MoveEnd wdCharacter, -1
      Rng.Start = .Range.End
    End With
    Select Case .FormFields("ObituaryDD").Result
       'Case for Tributes
      Case "Tributes"
      If InStr(Rng.Text, "") = 0 Then
      .Bookmarks.Add Name:="Middle"
      ActiveDocument.Bookmarks("Start").Range.InsertAfter "database, "
     ActiveDocument.Bookmarks("Start").Range.InsertBefore "United States Obituary Collection," & Chr(211)
        ActiveDocument.Bookmarks("Start").Range.InsertBefore Chr(210)
        ActiveDocument.Bookmarks("Middle").Range.Font.Italic = False
        With Rng
        .InsertAfter " (http://www.tributes.com : viewed " & _
          Format(Now, "D MMMM YYYY") & "), "
          .Font.Italic = False
          .Collapse wdCollapseEnd
          End With
           'Drop Down for Entry
    Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormDropDown)
    With FmFld
        .Name = "EntryDD"
        .EntryMacro = ""
        .ExitMacro = ""
        .Enabled = True
        With .DropDown.ListEntries
        .Add Name:="no entry for "
        .Add Name:="entry for "
        End With
    End With
     With Rng
     .End = FmFld.Range.End
     .Collapse wdCollapseEnd
         End With
           'Formfield for Firstname Lastname
        Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormTextInput)
        FmFld.TextInput.EditType wdRegularText, "Firstname Lastname", Format:="Title Case"
        With Rng
          .End = FmFld.Range.End
          .InsertAfter ", ("
          .Collapse wdCollapseEnd
          End With
          'Formfield for Death Year
        Set FmFld = .FormFields.Add(Range:=Rng, Type:=wdFieldFormTextInput)
        FmFld.TextInput.EditType wdRegularText, "Death Year"
        With Rng
         .End = FmFld.Range.End
          .InsertAfter ")."
          .Collapse wdCollapseEnd
            'Bookmark for End of Citation
           .Bookmarks.Add Name:="End"
           FmFld.ExitMacro = "UnlinkItalic"
           .Collapse wdCollapseEnd
           End With
           ActiveDocument.Bookmarks("ObituaryDD").Range.Font.Italic = True
           End If
      Case Else: Rng.Text = Chr(211)
    End Select
    .Protect Type:=Prot, Password:=Pwd, NoReset:=True
End If
End With
Set FmFld = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
Sub UnlinkItalic()
'Unlink Database Macro
With ActiveDocument
 If .ProtectionType <> wdNoProtection Then
   .Unprotect Password:=Pwd
   End If
 Dim i As Long, FmFld As FormField, Rng As Range
 For Each FmFld In ActiveDocument.FormFields
 i = Len(FmFld.Result)
 Set Rng = FmFld.Range
 If FmFld.Range.Font.Italic = True Then
 Rng.Fields.Unlink
 Rng.End = Rng.End + i
 Rng.Font.Italic = True
 Else
   Rng.Fields.Unlink
   End If
   Next FmFld
lbl_Exit:
   Set FmFld = Nothing
   Set Rng = Nothing
    .GoTo What:=wdGoToBookmark, Name:="End"
          Dim Bookmark As Bookmark
      ActiveDocument.Bookmarks.ShowHidden = True
      If ActiveDocument.Bookmarks.Count >= 1 Then
         For Each Bookmark In ActiveDocument.Bookmarks
            Bookmark.Delete
         Next Bookmark
         Selection.MoveRight Unit:=wdCharacter, Count:=1
        End If
      End With
End Sub

I have only included one of the cases to shorten the code. Thanks for your help-

[macropod]

Try:

Sub UnlinkItalic()
'Unlink Database Macro
Dim bItal As Boolean, Rng As Range
Const Pwd As String = ""
With ActiveDocument
  If .ProtectionType <> wdNoProtection Then
   .Unprotect Password:=Pwd
  End If
  While .FormFields.Count > 0
    Set Rng = .Bookmarks(.FormFields(1).Name).Range
    With Rng
      bItal = .Fields(1).Code.Font.Italic
      .End = .End + 1
      .Fields(1).Unlink
      .End = .End - 1
      .Font.Italic = bItal
    End With
  Wend
End With
End Sub

[brent chadwick]

Thanks Paul, works great. Again you have managed to make my brain explode. Questions:
1) what does "bltal" stand for?
2) would there have been a better way to write the bookmark code in the conditional content macro?
3) I've looked for a way to use range object to move cursor to right/left and only have seen "Selection.MoveRight Unit: wdCharacter, Count:=1"?
4) If Range object is better that Selection, why does Word record only "Selection"? Again thanks-

[macropod]

1) bItal is a Boolean that stores whether the font is italic, so it can be reapplied to the unlinked range.
2) I didn't look at the inner workings of the rest of your code. That said, I've demonstrated the conditional content output in code I've provided before.
3) You'll note that I don't move the cursor or work with the Selection - I work with range objects and manipulate them. The latter is far more efficient.
4) The macro recorder is as dumb as a box of rocks.