Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #31  
Old 03-14-2018, 02:24 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,199
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Your code's main Select Case statement is all wrong. You shouldn't have all those:
End Select
Select Case .Title
line pairs. You could also re-code the sub so the protection is processed only once. Similarly, where you don't change the font attributes for a given dropdown, there's no point having:
.Font.ColorIndex = wdAuto
for any of them, let alone all. You have again 'created' your own BackgroundPatternColorIndex - there is no such thing as 'Red'; it's wdRed. Basic coding errors of this kind would be trapped if you added:
Option Explicit
to the top of the code module.

The problems with "Unsatisfactory" and "Adequate" are most likely because what you're testing is not exactly the same as the dropdown selection. I also can't see the point of having BackgroundPatternColorIndex for your "Schedule", "GM" & "Cash" cases, as they effectively all produce the same output.

As for the document being 'frozen', your code applies 'filling in forms' protection once one of the designated content controls is exited, regardless of whether that protection was applied beforehand. The freezing might also result from the code hanging due to such simple errors as 'Red'.

Try the following:
Code:
Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Dim bProt As Long: Const StrPwd As String = "abc"
With CCtrl
  If (.Title <> "Finding") And (.Title <> "Finding") And (.Title <> "Schedule") And (.Title <> "GM") And (.Title <> "Cash") Then Exit Sub
  With ActiveDocument
    bProt = .ProtectionType
    If bProt <> wdNoProtection Then .Unprotect Password:=StrPwd
  End With
  Select Case .Title
    Case "Finding"
      With .Range
        Select Case .Text
          Case "A"
            .Cells(1).Shading.BackgroundPatternColorIndex = wdRed
          Case "B"
            .Cells(1).Shading.BackgroundPatternColor = RGB(255, 153, 0)
          Case "C"
            .Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
          Case Else
            .Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
        End Select
      End With
    Case "Rating"
      With .Range
        Select Case .Text
          Case "Satisfactory"
            .Cells(1).Shading.BackgroundPatternColorIndex = wdBrightGreen
          Case "Adequate"
            .Cells(1).Shading.BackgroundPatternColorIndex = wdBrightYellow
          Case "Requires Improvement"
            .Cells(1).Shading.BackgroundPatternColor = RGB(255, 153, 0)
          Case "Unsatisfactory"
            .Cells(1).Shading.BackgroundPatternColorIndex = wdRed
          Case Else
            .Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
        End Select
      End With
    Case "Schedule"
      With .Range
        Select Case .Text
          Case "No"
            .Font.ColorIndex = wdRed
          Case Else
            .Font.ColorIndex = wdAuto
        End Select
      End With
    Case "GM"
      With .Range
        Select Case .Text
          Case "Lower than ORA"
            .Font.ColorIndex = wdRed
          Case Else
            .Font.ColorIndex = wdAuto
        End Select
      End With
    Case "Cash"
      With .Range
        Select Case .Text
          Case "Negative"
            .Font.ColorIndex = wdRed
          Case Else
            .Font.ColorIndex = wdAuto
        End Select
      End With
  End Select
End With
If bProt <> wdNoProtection Then ActiveDocument.Protect bProt, True, StrPwd
End Sub

__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #32  
Old 03-14-2018, 05:09 PM
anakuprava anakuprava is offline Windows 10 Office 2016
Novice
 
Join Date: Mar 2018
Posts: 4
anakuprava is on a distinguished road
Default

Code is working but entire file is still frozen..
How can I remove the protection you mentioned? I want to have these dropdowns in the file and still be able to edit the rest of the document. Should the code you copied have already done that? I apologize for asking trivial questions, this is the first time I'm dealing with codes and thanks for help!

Quote:
Originally Posted by macropod View Post
Your code's main Select Case statement is all wrong. You shouldn't have all those:
End Select
Select Case .Title
line pairs. You could also re-code the sub so the protection is processed only once. Similarly, where you don't change the font attributes for a given dropdown, there's no point having:
.Font.ColorIndex = wdAuto
for any of them, let alone all. You have again 'created' your own BackgroundPatternColorIndex - there is no such thing as 'Red'; it's wdRed. Basic coding errors of this kind would be trapped if you added:
Option Explicit
to the top of the code module.

The problems with "Unsatisfactory" and "Adequate" are most likely because what you're testing is not exactly the same as the dropdown selection. I also can't see the point of having BackgroundPatternColorIndex for your "Schedule", "GM" & "Cash" cases, as they effectively all produce the same output.

As for the document being 'frozen', your code applies 'filling in forms' protection once one of the designated content controls is exited, regardless of whether that protection was applied beforehand. The freezing might also result from the code hanging due to such simple errors as 'Red'.
Reply With Quote
  #33  
Old 09-10-2018, 12:48 PM
andreamills127 andreamills127 is offline Windows 10 Office v. X
Novice
 
Join Date: Sep 2018
Posts: 2
andreamills127 is on a distinguished road
Default

Hi, I have just managed to colour code a drop down list in Word with a macro (even though I've never done anything like that before!) but can I have two different drop down lists (called different names) with different colour coding in the same document?

I used this for the first one:

Code:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
With ContentControl.Range
    If ContentControl.Title = "CC" Then
        Select Case .Text
            Case "NC"
                .Cells(1).Shading.BackgroundPatternColor = wdColorRed
            Case "OBS"
                .Cells(1).Shading.BackgroundPatternColor = wdColorLightOrange
            Case "GP"
                .Cells(1).Shading.BackgroundPatternColor = wdColorLime
            Case "REC"
                .Cells(1).Shading.BackgroundPatternColor = wdColorSkyBlue
            Case "NI"
                .Cells(1).Shading.BackgroundPatternColor = wdColorGray15
            Case Else
                .Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
        End Select
    End If
End With
End Sub
I've tried copying and pasting this into the same module and another one (changing the title name) but I'm obviously doing something wrong?

Last edited by macropod; 09-10-2018 at 02:56 PM. Reason: Added code tags & formatting
Reply With Quote
  #34  
Old 09-10-2018, 02:55 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,199
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Your document description and your code are both for content controls, not formfields, so I've moved your post to a thread dealing with content controls.

Perhaps you could attach a document to a post with some representative data (delete anything sensitive) so we can see what the issue might be there? You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.

Note: Some of your colour designations, as creative as they are, are entirely invalid (i.e. they don't exist). You can't go making up your own colour names willy-nilly; you can only use the ones that Word provides.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #35  
Old 09-11-2018, 09:12 AM
andreamills127 andreamills127 is offline Windows 10 Office v. X
Novice
 
Join Date: Sep 2018
Posts: 2
andreamills127 is on a distinguished road
Default

Hi Macropod, thank you for replying.

Apologies for putting the question on the wrong thread, it's my first time on a forum!

I'm attaching the word document. The code below works fine for the drop down box called "CC" but I don't know how to do another set of code for the drop down box "Summary". Hope this makes sense. I do not really have an idea of how to do the second one but I have tried copying and pasting the same code (but edited to refer to "Summary") into the same screen as the first one and also into another module screen.

I didn't make up the colours but got them from here: https://github.com/OfficeDev/VBA-con...ration-word.md and they all seem to work fine Maybe word is just interpreting them for me but they all come up as slightly different.
Reply With Quote
  #36  
Old 12-18-2018, 06:28 PM
headlockpdp headlockpdp is offline Windows 10 Office 2016
Novice
 
Join Date: Dec 2018
Posts: 2
headlockpdp is on a distinguished road
Default Highlighting the entire row

Hello,

How do I set conditional formatting to highlight the entire row in a table?

My document has 4 columns. In one of the columns I have a drop down content control box that I would like to use in order to change the color fill for the entire row.


The code below only highlights that particular cell rather than the whole row:


Code:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
With ContentControl
  If Len(.Title) < 6 Then Exit Sub
  If Left(.Title, 6) = "Status" Then
    Select Case .Range.Text
      Case "COMPLETE": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdGreen
      Case "Pending": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
      Case Else: .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
    End Select
  End If
End With
End Sub

Last edited by macropod; 12-18-2018 at 06:29 PM. Reason: Added code tags
Reply With Quote
  #37  
Old 12-18-2018, 06:32 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,199
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Simply change .Cells to .Rows

PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #38  
Old 12-18-2018, 08:15 PM
gmaxey gmaxey is offline Windows 10 Office 2016
Word MVP 2003-2009
 
Join Date: May 2010
Location: Marble, NC
Posts: 829
gmaxey will become famous soon enough
Default

Paul,


Not very elegant but one may have to deal with merged cells:

Code:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
With ContentControl
  If Len(.Title) < 6 Then Exit Sub
  If Left(.Title, 6) = "Status" Then
    On Error GoTo Err_Merged
    Select Case .Range.Text
      Case "COMPLETE"
        .Range.Rows(1).Shading.BackgroundPatternColorIndex = wdGreen
      Case "Pending": .Range.Rows(1).Shading.BackgroundPatternColorIndex = wdYellow
      Case Else: .Range.Rows(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
    End Select
  End If
End With
lbl_Exit:
  Exit Sub
Err_Merged:
  DealWithMergedCells ContentControl
End Sub

Sub DealWithMergedCells(oCC As ContentControl)
Dim oCellRef As Cell, oCell As Cell
  Set oCellRef = oCC.Range.Cells(1)
  Select Case oCC.Range.Text
    Case "COMPLETE"
      oCC.Range.Cells(1).Shading.BackgroundPatternColorIndex = wdGreen
    Case "Pending"
       oCC.Range.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
    Case Else
       oCC.Range.Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
  End Select
  For Each oCell In oCC.Range.Tables(1).Range.Cells
    If oCell.RowIndex = oCellRef.RowIndex Then
      oCell.Shading.BackgroundPatternColorIndex = oCC.Range.Cells(1).Shading.BackgroundPatternColorIndex
    End If
  Next
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #39  
Old 12-18-2018, 08:24 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,199
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Hi Greg,

Something like that should only be needed if there are vertically-merged cells, in which case, I'd suggest:
Code:
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
Dim r As Long, TblCell As Cell, Clr As Long
With ContentControl
  If Left(.Title, 6) = "Status" Then
    Select Case .Range.Text
      Case "COMPLETE": Clr = wdGreen
      Case "Pending": Clr = wdYellow
      Case Else: Clr = wdNoHighlight
    End Select
    r = .Range.Cells(1).RowIndex
    With .Range.Tables(1).Range
      For Each TblCell In .Cells
        With TblCell
          If .RowIndex = r Then .Shading.BackgroundPatternColorIndex = Clr
        End With
      Next
    End With
  End If
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #40  
Old 12-18-2018, 08:40 PM
gmaxey gmaxey is offline Windows 10 Office 2016
Word MVP 2003-2009
 
Join Date: May 2010
Location: Marble, NC
Posts: 829
gmaxey will become famous soon enough
Default

Exactly +1
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #41  
Old 12-19-2018, 07:57 AM
headlockpdp headlockpdp is offline Windows 10 Office 2016
Novice
 
Join Date: Dec 2018
Posts: 2
headlockpdp is on a distinguished road
Default

Thank you for the help!

One last question, instead of a drop down menu, can I use a check box for conditional formatting? If checked, highlight row green. If not, no highlights.
Reply With Quote
  #42  
Old 12-19-2018, 02:31 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,199
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Quote:
Originally Posted by headlockpdp View Post
One last question, instead of a drop down menu, can I use a check box for conditional formatting? If checked, highlight row green. If not, no highlights.
Yes, you can do that, in which case it's simply a matter of testing the content control's checked state. For example, replace:
Code:
    Select Case .Range.Text
      Case "COMPLETE": Clr = wdGreen
      Case "Pending": Clr = wdYellow
      Case Else: Clr = wdNoHighlight
    End Select
with:
Code:
    Select Case .Checked
      Case True: Clr = wdGreen
      Case Else: Clr = wdNoHighlight
    End Select
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
Reply

Tags
color, dropdown, reaction

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
block selection in dropdown list Intruder Excel 2 01-10-2013 10:20 AM
Dropdown selection value coconutt Word VBA 5 09-13-2012 05:23 PM
Change cell color when selection is made from a drop down list fedcco Excel 12 08-28-2012 10:43 PM
Autofill a form which is contingent on a dropdown selection. biffle0764 Word 2 05-09-2012 12:54 PM
Change cell color everytime a value is selected in dropdown list angelica_gloria Excel 4 01-27-2012 06:47 PM


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


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft