Simple De-Activate
Bob,
I know I have pestered you too much already, and for that I am sorry. but
I'm unsure why you are not able to give me a "simple" de-activate script
which I could paste in each worksheet with the original script.
In my naivete I keep hoping to see a script as short as the original, which
you would instruct me to paste only into the worksheets I want to use it in.
Then, I would have two small lines of code which I could easily paste into
whatever sheets I want to use it in--and by the way, I took out the last few
lines so that I only use the highlighted row portion, and leave off the
column and cell highlighting.
What do you think? Is there a simple script that matches the original on
line by line and just returns the cursor to the default setting when I choose
the "de-activate" option?
I will try the full-fledged workbook solution on my own at home.
All the best,
Jay
"Bob Phillips" wrote:
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?
|