Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 25 of 25

Thread: Macro not functioning properly

  1. #21
    While Greg's macro calculates the whole document and colours cells, you can use the count part to update the counts in real time as the controls are changed (note they don't run the exit code until you actually click outside the control) if you add content controls at the end for the counts (see attached).

    FWIW I used my add-in to convert the controls from combo boxes to list boxes and add the extra controls (and in the process found a bug in my add-in which I have fixed)
    Attached Files Attached Files
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  2. #22
    Thank you folks very much. Especially for the sample code. I would like to change the color of the cells as the User makes their choice, but there are couple of things in the example macros I do not understand, as well as the VBEditor. What is the purpose of the DoEvents entry and the Lbl_Exit? Also, where in the document would I place the macro, in the document or in a module? Would it automatically run or need I launch it in some way?

    Good to know your Add-In is fixed. I don't feel so bad leaning on you so much!

    VR,

    Fergie

  3. #23
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    2,888
    Location
    Graham has already given you the code for changing the cells as the user makes selection (and exits the cell). It is in the ThisDocument module. I would have written it like this

    Sub Document_ContentControlOnExit(ByVal oCC As ContentControl, Cancel As Boolean)
      If oCC.Type = 3 Or oCC.Type = 4 Then
        Select Case oCC.Range.Text
          Case "Y": oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorGreen
          Case "N": oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorRed
          Case "NA": oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorBlue
          Case Else: oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorWhite
        End Select
      UpdateTotals
      End If
    lbl_Exit:
      Exit Sub
    End Sub
    When you don't understand the purpose of something. Select it e.g., DoEvents and press F1. That opens any associated help.

    lbl_Exit is just a label. I use it and so does Graham. It is a coding style. When actually serving a purpose it may look like this:

    Sub Demo()
     Dim oRng As Range
     Set oRng = ActiveDocument.Range
     On Error GoTo lbl_Err:
     'Force and error for demo
     Err.Raise 6
    lbl_Exit:
      Set oRng = Nothing
      Exit Sub
    lbl_Err:
      MsgBox Err.Number & " " & Err.Description
      Resume lbl_Exit
    End Sub
    Greg

    Visit my website: http://gregmaxey.com

  4. #24
    Just for fun, I agree with Greg's modifications, though changing the code to

    Option Explicit
    
    Sub Document_ContentControlOnExit(ByVal oCC As ContentControl, Cancel As Boolean)
        If oCC.Type = 3 Or oCC.Type = 4 Then
            Select Case oCC.Range.Text
                Case "Y"
                    oCC.Range.Cells(1).Shading.BackgroundPatternColor = &H50B000
                    oCC.Range.Font.ColorIndex = wdWhite
                Case "N"
                    oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorRed
                    oCC.Range.Font.ColorIndex = wdWhite
                Case "NA"
                    oCC.Range.Cells(1).Shading.BackgroundPatternColor = &HC07000
                    oCC.Range.Font.ColorIndex = wdWhite
                Case Else
                    oCC.Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
                    oCC.Range.Font.Color = &H808080
            End Select
            UpdateTotals
        End If
    lbl_Exit:
        Exit Sub
    End Sub
    will make the selections more readable and match the colours I used in the attachment I returned earlier.
    The code that updates the totals in that attachment can also be tweaked further
    Option Explicit
    
    Sub UpdateTotals()
    'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 12/2/2018
    'Graham Mayor - https://www.gmayor.com - Last updated - 04 Dec 2018
    
    Dim lngY As Long, lngN As Long, lngNA As Long, lngNullorInvalid As Long
    Dim oCC As ContentControl
        For Each oCC In ActiveDocument.Range.ContentControls
            If oCC.Type = 3 Or oCC.Type = 4 Then
                Select Case oCC.Range.Text
                    Case Is = "Y": lngY = lngY + 1
                    Case Is = "N": lngN = lngN + 1
                    Case Is = "NA": lngNA = lngNA + 1
                    Case Else: lngNullorInvalid = lngNullorInvalid + 1
                End Select
            End If
            DoEvents
        Next oCC
    
        ActiveDocument.SelectContentControlsByTitle("Not Selected").Item(1).Range.Text = lngNullorInvalid
        ActiveDocument.SelectContentControlsByTitle("Yes").Item(1).Range.Text = lngY
        ActiveDocument.SelectContentControlsByTitle("No").Item(1).Range.Text = lngN
        ActiveDocument.SelectContentControlsByTitle("NA").Item(1).Range.Text = lngNA
    
    lbl_Exit:
        Set oCC = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #25
    Thank you, very much.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •