Thread: [Solved] Code doesnt work properly
View Single Post
 
Old 04-02-2015, 04:26 AM
ksigcajun ksigcajun is offline Windows 7 64bit Office 2010 64bit
Advanced Beginner
 
Join Date: May 2014
Posts: 76
ksigcajun is on a distinguished road
Default Code doesnt work properly

The code below will not work properly. I have drop down menu in a Word document called "Grade" and when a user selects Low it will populate text that should bold 7.15 and 2,000,000 while underlining Umbrella Insurance.

If a user selects Minimal, nothing happens and its left blanks, which is correct.

Problem is when a user selects Low, it works. If they switch to Minimal and then choose Low, the entire paragraph is bolded and the alignment is messed up.

Can someone tell me where my code is messing up and how can I correct it?

Thanks!

PHP Code:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControlCancel As Boolean)
Dim strDetails As String
Dim oCC 
As ContentControl
Dim oRng 
As Range
  Set oCC 
ActiveDocument.SelectContentControlsByTitle("Grade").Item(1)
    
Select Case oCC.Range.Text
      
Case "LOW"
        
strDetails "7.1.5     Umbrella Insurance with a minimum limit of not less than $2,000,000 per" vbCr _
      
"             occurrence." 
      
Case "MINIMAL"
        
strDetails " "
    
End Select
    
If ActiveDocument.Bookmarks.Exists("BM7"Then
      Set oRng 
ActiveDocument.Bookmarks("BM7").Range
      oRng
.Text strDetails
          ActiveDocument
.Bookmarks.Add "BM7"oRng
          End 
If
            
With oRng.Find
    
.ClearFormatting
    
.Replacement.ClearFormatting
    
.Text "<Umbrella Insurance>"
    
.Replacement.Text "^&"
    
.MatchWildcards True
    
.Format True
    
.Replacement.Font.Underline wdUnderlineSingle
    
.Execute Replace:=wdReplaceAll
 
    
.Replacement.ClearFormatting
    
.Text "<2,000,000>"
    
.Replacement.Font.Bold True
    
.Execute Replace:=wdReplaceAll
 
    
.Text "<7.1.5>"
    
.Replacement.Font.Bold True
    
.Execute Replace:=wdReplaceAll
         End With
  End Sub 
Reply With Quote