View Single Post
  #15   Report Post  
Posted to microsoft.public.excel.misc
Bob Phillips
 
Posts: n/a
Default DE-ACTIVATE: Excel should feature a highlighted row/column cur

Jay,

Okay, how about this?

This solution provides a toolbar to switch highlighting on and off for every
sheet in the workbook. It allows setting highlighting, and then setting row
and column highlighting individually. The button tooltiptext shows whether
it is set or not, so you can easily check (although it is quite obvious with
the colours <G)

There is quite a bit of code. The first bit is workbook event code.
To input this code, right click on the Excel icon on the worksheet
(or next to the File menu if you maximise your workbooks),
select View Code from the menu, and paste the code

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Hiliter").Delete
On Error GoTo 0
End Sub

Private Sub Workbook_Open()

On Error Resume Next
Application.CommandBars("Hiliter").Delete
On Error GoTo 0

With Application.CommandBars
With .Add(Name:="Hiliter", temporary:=True)

With .Controls.Add(Type:=msoControlButton)
.Caption = "Hiliter"
.Style = msoButtonCaption
End With

Set ocHiliter = .Controls.Add(Type:=msoControlButton)
With ocHiliter
.BeginGroup = True
.FaceId = 20
.Tag = "Hiliter"
.OnAction = "setHiliter"
End With

Set ocHiliterRow = .Controls.Add(Type:=msoControlButton)
With ocHiliterRow
.FaceId = 1652
.Tag = "Row"
.OnAction = "setHiliter"
End With

Set ocHiliterCol = .Controls.Add(Type:=msoControlButton)
With ocHiliterCol
.FaceId = 1650
.Tag = "Column"
.OnAction = "setHiliter"
End With

.Visible = True

End With

End With

CheckHiliterNames

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
CheckHiliterNames
Hilite Sh, ActiveCell
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)

Hilite Sh, Target

End Sub


The next bit goes in a standard code module

Option Explicit
Option Private Module


Public fHiliter As Boolean
Public fRowHiliter As Boolean
Public fColHiliter As Boolean

Public ocHiliter As CommandBarControl
Public ocHiliterRow As CommandBarControl
Public ocHiliterCol As CommandBarControl


Private Sub SetHiliter()

With ThisWorkbook

Select Case Application.CommandBars.ActionControl.Tag

Case "Hiliter":
fHiliter = Not fHiliter
.Names.Add Name:=.ActiveSheet.Name & _
"!__Hilite", RefersTo:=fHiliter
.Names.Add Name:=.ActiveSheet.Name & _
"!__HiliteRow", RefersTo:=fHiliter
.Names.Add Name:=.ActiveSheet.Name & _
"!__HiliteCol", RefersTo:=fHiliter

Case "Row":
fRowHiliter = Not fRowHiliter
.Names.Add Name:=.ActiveSheet.Name & _
"!__HiliteRow", RefersTo:=fRowHiliter

Case "Column":
fColHiliter = Not fColHiliter
.Names.Add Name:=.ActiveSheet.Name & _
"!__HiliteCol", RefersTo:=fColHiliter

End Select

End With

CheckHiliterNames
Hilite ActiveSheet, ActiveCell

End Sub

Public Sub Hilite(ByVal Sh As Object, ByVal Target As Range)

Sh.Cells.FormatConditions.Delete

If fHiliter Then


With Target

If fRowHiliter Then

With .EntireRow
.FormatConditions.Add Type:=xlExpression,
Formula1:="TRUE"
With .FormatConditions(1)
With .Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
With .Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
.Interior.ColorIndex = 20
End With
End With

End If 'fRowHiliter

If fColHiliter Then

With .EntireColumn
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression,
Formula1:="TRUE"
With .FormatConditions(1)
With .Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
With .Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
.Interior.ColorIndex = 20
End With
End With

End If 'fColHiliter

.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = 36

End With

End If
End Sub

Public Sub CheckHiliterNames()
Dim sButtonSuffix As String

With ThisWorkbook

On Error Resume Next
fHiliter = Evaluate(.Names(.ActiveSheet.Name & _
"!__Hilite").RefersTo)
If Err.Number < 0 Then
.Names.Add Name:=.ActiveSheet.Name & "!__Hilite",
RefersTo:=fHiliter
.Names.Add Name:=.ActiveSheet.Name & "!__HiliteRow",
RefersTo:=fHiliter
.Names.Add Name:=.ActiveSheet.Name & "!__HiliteCol",
RefersTo:=fHiliter
End If
On Error GoTo 0
sButtonSuffix = IIf(fHiliter, "Set", "Not set")
ocHiliter.Caption = "Toggle highlighting - " & sButtonSuffix

On Error Resume Next
fRowHiliter = Evaluate(.Names(.ActiveSheet.Name & _
"!__HiliteRow").RefersTo)
If Err.Number < 0 Then
.Names.Add Name:=.ActiveSheet.Name & "!__HiliteRow",
RefersTo:=fRowHiliter
End If
On Error GoTo 0
sButtonSuffix = IIf(fRowHiliter, "Set", "Not set")
ocHiliterRow.Caption = "Row Hiliter - " & sButtonSuffix

On Error Resume Next
fColHiliter = Evaluate(.Names(.ActiveSheet.Name & _
"!__HiliteCol").RefersTo)
If Err.Number < 0 Then
.Names.Add Name:=.ActiveSheet.Name & "!__HiliteCol",
RefersTo:=fColHiliter
End If
On Error GoTo 0
sButtonSuffix = IIf(fColHiliter, "Set", "Not set")
ocHiliterCol.Caption = "Column Hiliter - " & sButtonSuffix

.Names(.ActiveSheet.Name & "!__Hilite").Visible = False
.Names(.ActiveSheet.Name & "!__HiliteRow").Visible = False
.Names(.ActiveSheet.Name & "!__HiliteCol").Visible = False

End With

End Sub


--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Indiana Jay" wrote in message
...
Bob,

Thanks for your help. And I like the idea of a toggle for Microsoft, but I
like better for me right now the ability to paste in the code as I need

for
multiple workbooks.

I was thinking I could paste in both the activate and de-activate codes
together on each sheet I wanted to use the feature on. Otherwise, I can

only
have this toggle button for the sheet you do it to.

Does that make sense? This way, it seems very straightforward and I can
share the feature with others. And we can use it only on the worksheets we
want to, and by simply de-activating get the sheets back to their

untouched,
native form.

It must be pretty simple (for you, not for me) to un-do your macro with

one
that puts everything back to the default setting. Is there a way to get

back
to the default settings with a "de-activate" code for now?

You're too good to me,

Jay

--------------------------------------------------------------------------

------------------------------


"Bob Phillips" wrote:


"Indiana Jay" wrote in message
...
Bob,

I'm not sure I can send this workbook with financial data from the

company
I'm doing contract accounting work for in Boston, but isn't there a

way to
De-Activate the code by reversing the steps the code does when it is
activated?



That is the principle of how you would do it. But your idea of a toggle

is
eminently sensible, and I think the way to go. Could you not strip the
confidential data out, even if it mean the data worksheets. I don't need

to
see the data, just have your workbook to add the toggle.


This is really what I need. And I now understand that the printing

codce
belongs with the workbook, not the worksheet. I did not read it

carefully
enough.



That''s good news.


By the way, what do you do for work? You seem to know this stuff

pretty
well.


I'm in IT, I'm a design consultant. I do a bit of Excel, Office, VBA, VB
work, but it is not my primary occupation.