Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-02-2015, 04:26 AM
ksigcajun ksigcajun is offline Code doesnt work properly Windows 7 64bit Code doesnt work properly Office 2010 64bit
Advanced Beginner
Code doesnt work properly
 
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
  #2  
Old 04-02-2015, 06:18 AM
gmayor's Avatar
gmayor gmayor is offline Code doesnt work properly Windows 7 64bit Code doesnt work properly Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

The following will do what you ask:

Code:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel 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
        oRng.Bookmarks.Add "BM7"

        Set oRng = ActiveDocument.Bookmarks("BM7").Range
        With oRng.Find
            Do While .Execute("Umbrella Insurance")
                oRng.Font.Underline = wdUnderlineSingle
                Exit Do
            Loop
        End With

        Set oRng = ActiveDocument.Bookmarks("BM7").Range
        With oRng.Find
            Do While .Execute("2,000,000")
                oRng.Font.Bold = True
                Exit Do
            Loop
        End With

        Set oRng = ActiveDocument.Bookmarks("BM7").Range
        With oRng.Find
            Do While .Execute("7.1.5")
                oRng.Font.Bold = True
                Exit Do
            Loop
        End With
    End If
lbl_Exit:
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 04-02-2015, 06:44 AM
ksigcajun ksigcajun is offline Code doesnt work properly Windows 7 64bit Code doesnt work properly Office 2010 64bit
Advanced Beginner
Code doesnt work properly
 
Join Date: May 2014
Posts: 76
ksigcajun is on a distinguished road
Default

Quote:
Originally Posted by gmayor View Post
The following will do what you ask:

Code:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel 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
        oRng.Bookmarks.Add "BM7"
 
        Set oRng = ActiveDocument.Bookmarks("BM7").Range
        With oRng.Find
            Do While .Execute("Umbrella Insurance")
                oRng.Font.Underline = wdUnderlineSingle
                Exit Do
            Loop
        End With
 
        Set oRng = ActiveDocument.Bookmarks("BM7").Range
        With oRng.Find
            Do While .Execute("2,000,000")
                oRng.Font.Bold = True
                Exit Do
            Loop
        End With
 
        Set oRng = ActiveDocument.Bookmarks("BM7").Range
        With oRng.Find
            Do While .Execute("7.1.5")
                oRng.Font.Bold = True
                Exit Do
            Loop
        End With
    End If
lbl_Exit:
    Exit Sub
End Sub
I tried the code and it works, but when I change the drop down menu from Low to Minimal and back to Low, the text is all bold and distorted.

Could this be an issue with formatting within the Word document since its pasting the text, removing it and adding it back?

Thanks!
Reply With Quote
  #4  
Old 04-02-2015, 07:32 AM
gmayor's Avatar
gmayor gmayor is offline Code doesnt work properly Windows 7 64bit Code doesnt work properly Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

There is no 'pasting' involved. However add a line to reset the font and it works fine here.

Code:
If ActiveDocument.Bookmarks.Exists("BM7") Then
        Set orng = ActiveDocument.Bookmarks("BM7").Range
        orng.Text = strDetails
        orng.Bookmarks.Add "BM7"
        orng.Font.Reset
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #5  
Old 04-02-2015, 07:52 AM
ksigcajun ksigcajun is offline Code doesnt work properly Windows 7 64bit Code doesnt work properly Office 2010 64bit
Advanced Beginner
Code doesnt work properly
 
Join Date: May 2014
Posts: 76
ksigcajun is on a distinguished road
Default

Quote:
Originally Posted by gmayor View Post
There is no 'pasting' involved. However add a line to reset the font and it works fine here.

Code:
If ActiveDocument.Bookmarks.Exists("BM7") Then
        Set orng = ActiveDocument.Bookmarks("BM7").Range
        orng.Text = strDetails
        orng.Bookmarks.Add "BM7"
        orng.Font.Reset
Now its always displaying the text as Verdana, 10, italic and in blue.

Even when I correct it as Arial, 10, black....it still switches back when I change the drop down option.

Any suggestions?
Reply With Quote
  #6  
Old 04-02-2015, 09:56 PM
gmayor's Avatar
gmayor gmayor is offline Code doesnt work properly Windows 7 64bit Code doesnt work properly Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

My guess is that this is related to the styles in the document and the likelihood that you have used manual formatting. What is the format of the underlying style at the bookmark?

To fully establish what is happening it would be necessary to see the document. Can you attach it to the thread?
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #7  
Old 04-06-2015, 07:41 AM
ksigcajun ksigcajun is offline Code doesnt work properly Windows 7 64bit Code doesnt work properly Office 2010 64bit
Advanced Beginner
Code doesnt work properly
 
Join Date: May 2014
Posts: 76
ksigcajun is on a distinguished road
Default

Quote:
Originally Posted by gmayor View Post
My guess is that this is related to the styles in the document and the likelihood that you have used manual formatting. What is the format of the underlying style at the bookmark?

To fully establish what is happening it would be necessary to see the document. Can you attach it to the thread?
Your guess was correct. Once I corrected the styles, it worked perfectly.

Thanks a lot!
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
Deleting and Inserting in Track Change doesnt work balaji.c Word 10 01-02-2014 12:14 AM
Powerpoint save as WMV but media doesnt work. hooney PowerPoint 0 02-21-2013 09:45 PM
Safe Senders Doesnt work Anil Kaul Outlook 0 11-16-2012 01:28 PM
Code doesnt work properly Command Button doesnt work on network rmw85 Word VBA 1 04-25-2012 01:02 PM
Code doesnt work properly My Product code doesnt work!!!! PLEASE HELP dukquaknoobhack Office 1 01-05-2012 03:43 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 10:59 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft